Ignore:
Timestamp:
Apr 17, 2019, 12:58:41 AM (5 years ago)
Author:
chronos
Message:
  • Modified: Propagate project build mode options to used packages.
  • Added: Check memory leaks using heaptrc.
  • Modified: Update BGRABitmap package.
Location:
GraphicTest
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest

    • Property svn:ignore

      •  

        old new  
        88GraphicTest.lps
        99GraphicTest.dbg
         10heaptrclog.trc

  • GraphicTest/Packages/bgrabitmap/bgragradientscanner.pas

    r494 r521  
    1111
    1212type
    13   { TBGRASimpleGradientWithoutGammaCorrection }
    14 
    15   TBGRASimpleGradientWithoutGammaCorrection = class(TBGRACustomGradient)
    16   private
     13  TBGRAColorInterpolation = (ciStdRGB, ciLinearRGB, ciLinearHSLPositive, ciLinearHSLNegative, ciGSBPositive, ciGSBNegative);
     14  TBGRAGradientRepetition = (grPad, grRepeat, grReflect, grSine);
     15
     16  { TBGRASimpleGradient }
     17
     18  TBGRASimpleGradient = class(TBGRACustomGradient)
     19  protected
    1720    FColor1,FColor2: TBGRAPixel;
    1821    ec1,ec2: TExpandedPixel;
     22    FRepetition: TBGRAGradientRepetition;
     23    constructor Create(AColor1,AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition); overload;
     24    constructor Create(AColor1,AColor2: TExpandedPixel; ARepetition: TBGRAGradientRepetition); overload;
     25    function InterpolateToBGRA(position: word): TBGRAPixel; virtual; abstract;
     26    function InterpolateToExpanded(position: word): TExpandedPixel; virtual; abstract;
    1927  public
    20     constructor Create(Color1,Color2: TBGRAPixel);
     28    class function CreateAny(AInterpolation: TBGRAColorInterpolation; AColor1,AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; overload;
     29    class function CreateAny(AInterpolation: TBGRAColorInterpolation; AColor1,AColor2: TExpandedPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; overload;
    2130    function GetColorAt(position: integer): TBGRAPixel; override;
    2231    function GetColorAtF(position: single): TBGRAPixel; override;
    … …  
    2433    function GetExpandedColorAtF(position: single): TExpandedPixel; override;
    2534    function GetAverageColor: TBGRAPixel; override;
    26     function GetMonochrome: boolean; override;
    27   end;
    28 
    29   { TBGRASimpleGradientWithGammaCorrection }
    30 
    31   TBGRASimpleGradientWithGammaCorrection = class(TBGRACustomGradient)
    32   private
    33     FColor1,FColor2: TBGRAPixel;
    34     ec1,ec2: TExpandedPixel;
    35   public
    36     constructor Create(Color1,Color2: TBGRAPixel);
    37     function GetColorAt(position: integer): TBGRAPixel; override;
    38     function GetColorAtF(position: single): TBGRAPixel; override;
    39     function GetAverageColor: TBGRAPixel; override;
    40     function GetExpandedColorAt(position: integer): TExpandedPixel; override;
    41     function GetExpandedColorAtF(position: single): TExpandedPixel; override;
    4235    function GetAverageExpandedColor: TExpandedPixel; override;
    4336    function GetMonochrome: boolean; override;
    44   end;
    45 
    46   THueGradientOption = (hgoRepeat, hgoPositiveDirection, hgoNegativeDirection, hgoHueCorrection, hgoLightnessCorrection);
     37    property Repetition: TBGRAGradientRepetition read FRepetition write FRepetition;
     38  end;
     39
     40  { TBGRASimpleGradientWithoutGammaCorrection }
     41
     42  TBGRASimpleGradientWithoutGammaCorrection = class(TBGRASimpleGradient)
     43  protected
     44    function InterpolateToBGRA(position: word): TBGRAPixel; override;
     45    function InterpolateToExpanded(position: word): TExpandedPixel; override;
     46  public
     47    constructor Create(Color1,Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition = grPad); overload;
     48    constructor Create(Color1,Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition = grPad); overload;
     49  end;
     50
     51  { TBGRASimpleGradientWithGammaCorrection }
     52
     53  TBGRASimpleGradientWithGammaCorrection = class(TBGRASimpleGradient)
     54  protected
     55    function InterpolateToBGRA(position: word): TBGRAPixel; override;
     56    function InterpolateToExpanded(position: word): TExpandedPixel; override;
     57  public
     58    constructor Create(Color1,Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition = grPad); overload;
     59    constructor Create(Color1,Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition = grPad); overload;
     60  end;
     61
     62  THueGradientOption = (hgoRepeat, hgoReflect,                       //repetition
     63                        hgoPositiveDirection, hgoNegativeDirection,  //hue orientation
     64                        hgoHueCorrection, hgoLightnessCorrection);   //color interpolation
    4765  THueGradientOptions = set of THueGradientOption;
    4866
    4967  { TBGRAHueGradient }
    5068
    51   TBGRAHueGradient = class(TBGRACustomGradient)
     69  TBGRAHueGradient = class(TBGRASimpleGradient)
    5270  private
    53     FColor1,FColor2: TBGRAPixel;
    54     ec1,ec2: TExpandedPixel;
    5571    hsla1,hsla2: THSLAPixel;
    5672    hue1,hue2: longword;
    5773    FOptions: THueGradientOptions;
    5874    procedure Init(c1,c2: THSLAPixel; AOptions: THueGradientOptions);
    59     function GetColorNoBoundCheck(position: integer): THSLAPixel;
     75    function InterpolateToHSLA(position: word): THSLAPixel;
     76  protected
     77    function InterpolateToBGRA(position: word): TBGRAPixel; override;
     78    function InterpolateToExpanded(position: word): TExpandedPixel; override;
    6079  public
    6180    constructor Create(Color1,Color2: TBGRAPixel; options: THueGradientOptions); overload;
     81    constructor Create(Color1,Color2: TExpandedPixel; options: THueGradientOptions); overload;
    6282    constructor Create(Color1,Color2: THSLAPixel; options: THueGradientOptions); overload;
    6383    constructor Create(AHue1,AHue2: Word; Saturation,Lightness: Word; options: THueGradientOptions); overload;
    64     function GetColorAt(position: integer): TBGRAPixel; override;
    65     function GetColorAtF(position: single): TBGRAPixel; override;
    66     function GetAverageColor: TBGRAPixel; override;
    67     function GetExpandedColorAt(position: integer): TExpandedPixel; override;
    68     function GetExpandedColorAtF(position: single): TExpandedPixel; override;
    69     function GetAverageExpandedColor: TExpandedPixel; override;
    7084    function GetMonochrome: boolean; override;
    7185  end;
    … …  
    96110  end;
    97111
     112  TBGRAGradientScannerInternalScanNextFunc = function():single of object;
     113  TBGRAGradientScannerInternalScanAtFunc = function(const p: TPointF):single of object;
     114
    98115  { TBGRAGradientScanner }
    99116
    … …  
    101118  protected
    102119    FGradientType: TGradientType;
    103     FOrigin1,FOrigin2: TPointF;
     120    FOrigin,FDir1,FDir2: TPointF;
     121    FRelativeFocal: TPointF;
     122    FRadius, FFocalRadius: single;
     123    FTransform, FHiddenTransform: TAffineMatrix;
    104124    FSinus: Boolean;
    105     u: TPointF;
    106     len,aFactor,aFactorF: single;
    107     mergedColor: TBGRAPixel;
    108     mergedExpandedColor: TExpandedPixel;
    109125    FGradient: TBGRACustomGradient;
    110126    FGradientOwner: boolean;
     127    FFlipGradient: boolean;
     128
     129    FMatrix: TAffineMatrix;
     130    FRepeatHoriz, FIsAverage: boolean;
     131    FAverageColor: TBGRAPixel;
     132    FAverageExpandedColor: TExpandedPixel;
     133    FScanNextFunc: TBGRAGradientScannerInternalScanNextFunc;
     134    FScanAtFunc: TBGRAGradientScannerInternalScanAtFunc;
     135    FFocalDistance: single;
     136    FFocalDirection, FFocalNormal: TPointF;
     137    FRadialDenominator, FRadialDeltaSign, maxW1, maxW2: single;
     138
     139    FPosition: TPointF;
    111140    FHorizColor: TBGRAPixel;
    112141    FHorizExpandedColor: TExpandedPixel;
    113     FVertical: boolean;
    114     FDotProduct,FDotProductPerp: Single;
    115     procedure Init(gtype: TGradientType; o1, o2: TPointF; Sinus: Boolean=False);
    116     procedure InitScanInline(x,y: integer);
     142
     143    procedure Init(AGradientType: TGradientType; AOrigin, d1: TPointF; ATransform: TAffineMatrix; Sinus: Boolean=False); overload;
     144    procedure Init(AGradientType: TGradientType; AOrigin, d1, d2: TPointF; ATransform: TAffineMatrix; Sinus: Boolean=False); overload;
     145    procedure Init(AOrigin: TPointF; ARadius: single; AFocal: TPointF; AFocalRadius: single; ATransform: TAffineMatrix; AHiddenTransform: TAffineMatrix); overload;
     146
     147    procedure InitGradientType;
     148    procedure InitTransform;
     149    procedure InitGradient;
     150
     151    function ComputeRadialFocal(const p: TPointF): single;
     152
     153    function ScanNextLinear: single;
     154    function ScanNextReflected: single;
     155    function ScanNextDiamond: single;
     156    function ScanNextRadial: single;
     157    function ScanNextRadial2: single;
     158    function ScanNextRadialFocal: single;
     159    function ScanNextAngular: single;
     160
     161    function ScanAtLinear(const p: TPointF): single;
     162    function ScanAtReflected(const p: TPointF): single;
     163    function ScanAtDiamond(const p: TPointF): single;
     164    function ScanAtRadial(const p: TPointF): single;
     165    function ScanAtRadial2(const p: TPointF): single;
     166    function ScanAtRadialFocal(const p: TPointF): single;
     167    function ScanAtAngular(const p: TPointF): single;
     168
    117169    function ScanNextInline: TBGRAPixel; inline;
    118170    function ScanNextExpandedInline: TExpandedPixel; inline;
     171    procedure SetTransform(AValue: TAffineMatrix);
     172    procedure SetFlipGradient(AValue: boolean);
     173    function GetGradientColor(a: single): TBGRAPixel;
     174    function GetGradientExpandedColor(a: single): TExpandedPixel;
    119175  public
    120     constructor Create(c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF;
    121                        gammaColorCorrection: boolean = True; Sinus: Boolean=False);
    122     constructor Create(gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF; Sinus: Boolean=False; AGradientOwner: Boolean=False);
     176    constructor Create(AGradientType: TGradientType; AOrigin, d1: TPointF); overload;
     177    constructor Create(AGradientType: TGradientType; AOrigin, d1, d2: TPointF); overload;
     178    constructor Create(AOrigin, d1, d2, AFocal: TPointF; ARadiusRatio: single = 1; AFocalRadiusRatio: single = 0); overload;
     179    constructor Create(AOrigin: TPointF; ARadius: single; AFocal: TPointF; AFocalRadius: single); overload;
     180
     181    constructor Create(c1, c2: TBGRAPixel; AGradientType: TGradientType; AOrigin, d1: TPointF;
     182                       gammaColorCorrection: boolean = True; Sinus: Boolean=False); overload;
     183    constructor Create(c1, c2: TBGRAPixel; AGradientType: TGradientType; AOrigin, d1, d2: TPointF;
     184                       gammaColorCorrection: boolean = True; Sinus: Boolean=False); overload;
     185
     186    constructor Create(gradient: TBGRACustomGradient; AGradientType: TGradientType; AOrigin, d1: TPointF;
     187                       Sinus: Boolean=False; AGradientOwner: Boolean=False); overload;
     188    constructor Create(gradient: TBGRACustomGradient; AGradientType: TGradientType; AOrigin, d1, d2: TPointF;
     189                       Sinus: Boolean=False; AGradientOwner: Boolean=False); overload;
     190    constructor Create(gradient: TBGRACustomGradient; AOrigin: TPointF; ARadius: single; AFocal: TPointF;
     191                       AFocalRadius: single; AGradientOwner: Boolean=False); overload;
     192
     193    procedure SetGradient(c1,c2: TBGRAPixel; AGammaCorrection: boolean = true); overload;
     194    procedure SetGradient(AGradient: TBGRACustomGradient; AOwner: boolean); overload;
    123195    destructor Destroy; override;
    124196    procedure ScanMoveTo(X, Y: Integer); override;
    … …  
    129201    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override;
    130202    function IsScanPutPixelsDefined: boolean; override;
     203    property Transform: TAffineMatrix read FTransform write SetTransform;
     204    property Gradient: TBGRACustomGradient read FGradient;
     205    property FlipGradient: boolean read FFlipGradient write SetFlipGradient;
     206    property Sinus: boolean Read FSinus write FSinus;
    131207  end;
    132208
    … …  
    143219    FOpacity: byte;
    144220    FGrayscale: boolean;
     221    FRandomBuffer, FRandomBufferCount: integer;
    145222  public
    146223    constructor Create(AGrayscale: Boolean; AOpacity: byte);
    … …  
    213290  private
    214291      FTexture: IBGRAScanner;
     292      FOwnedScanner: TBGRACustomScanner;
    215293      FGlobalOpacity: Byte;
    216294      FScanNext : TScanNextPixelFunction;
    … …  
    219297  public
    220298    constructor Create(ATexture: IBGRAScanner; AGlobalOpacity: Byte = 255);
     299    constructor Create(ATexture: TBGRACustomScanner; AGlobalOpacity: Byte; AOwned: boolean);
    221300    destructor Destroy; override;
    222301    function IsScanPutPixelsDefined: boolean; override;
    … …  
    231310uses BGRABlend, Math;
    232311
     312{ TBGRASimpleGradient }
     313
     314constructor TBGRASimpleGradient.Create(AColor1, AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition);
     315begin
     316  FColor1 := AColor1;
     317  FColor2 := AColor2;
     318  ec1 := GammaExpansion(AColor1);
     319  ec2 := GammaExpansion(AColor2);
     320  FRepetition:= ARepetition;
     321end;
     322
     323constructor TBGRASimpleGradient.Create(AColor1, AColor2: TExpandedPixel;
     324  ARepetition: TBGRAGradientRepetition);
     325begin
     326  FColor1 := GammaCompression(AColor1);
     327  FColor2 := GammaCompression(AColor2);
     328  ec1 := AColor1;
     329  ec2 := AColor2;
     330  FRepetition:= ARepetition;
     331end;
     332
     333class function TBGRASimpleGradient.CreateAny(AInterpolation: TBGRAColorInterpolation;
     334  AColor1, AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient;
     335begin
     336  case AInterpolation of
     337    ciStdRGB: result := TBGRASimpleGradientWithoutGammaCorrection.Create(AColor1,AColor2);
     338    ciLinearRGB: result := TBGRASimpleGradientWithGammaCorrection.Create(AColor1,AColor2);
     339    ciLinearHSLPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection]);
     340    ciLinearHSLNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection]);
     341    ciGSBPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection, hgoHueCorrection, hgoLightnessCorrection]);
     342    ciGSBNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection, hgoHueCorrection, hgoLightnessCorrection]);
     343  end;
     344  result.Repetition := ARepetition;
     345end;
     346
     347class function TBGRASimpleGradient.CreateAny(AInterpolation: TBGRAColorInterpolation;
     348  AColor1, AColor2: TExpandedPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient;
     349begin
     350  case AInterpolation of
     351    ciStdRGB: result := TBGRASimpleGradientWithoutGammaCorrection.Create(AColor1,AColor2);
     352    ciLinearRGB: result := TBGRASimpleGradientWithGammaCorrection.Create(AColor1,AColor2);
     353    ciLinearHSLPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection]);
     354    ciLinearHSLNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection]);
     355    ciGSBPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection, hgoHueCorrection, hgoLightnessCorrection]);
     356    ciGSBNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection, hgoHueCorrection, hgoLightnessCorrection]);
     357  end;
     358  result.Repetition := ARepetition;
     359end;
     360
     361function TBGRASimpleGradient.GetAverageColor: TBGRAPixel;
     362begin
     363  result := InterpolateToBGRA(32768);
     364end;
     365
     366function TBGRASimpleGradient.GetAverageExpandedColor: TExpandedPixel;
     367begin
     368  Result:= InterpolateToExpanded(32768);
     369end;
     370
     371function TBGRASimpleGradient.GetColorAt(position: integer): TBGRAPixel;
     372begin
     373  case FRepetition of
     374  grSine: begin
     375            position := Sin65536(position and $ffff);
     376            if position = 65536 then
     377              result := FColor2
     378            else
     379              result := InterpolateToBGRA(position);
     380          end;
     381  grRepeat: result := InterpolateToBGRA(position and $ffff);
     382  grReflect:
     383    begin
     384      position := position and $1ffff;
     385      if position >= $10000 then
     386      begin
     387        if position = $10000 then
     388          result := FColor2
     389        else
     390          result := InterpolateToBGRA($20000 - position);
     391      end
     392      else
     393        result := InterpolateToBGRA(position);
     394    end;
     395  else
     396    begin
     397      if position <= 0 then
     398        result := FColor1 else
     399      if position >= 65536 then
     400        result := FColor2 else
     401        result := InterpolateToBGRA(position);
     402    end;
     403  end;
     404end;
     405
     406function TBGRASimpleGradient.GetColorAtF(position: single): TBGRAPixel;
     407begin
     408  if FRepetition <> grPad then
     409    result := GetColorAt(round(frac(position*0.5)*131072)) else  //divided by 2 for reflected repetition
     410  begin
     411    if position <= 0 then
     412      result := FColor1 else
     413    if position >= 1 then
     414      result := FColor2 else
     415      result := GetColorAt(round(position*65536));
     416  end;
     417end;
     418
     419function TBGRASimpleGradient.GetExpandedColorAt(position: integer
     420  ): TExpandedPixel;
     421begin
     422  case FRepetition of
     423  grSine: begin
     424            position := Sin65536(position and $ffff);
     425            if position = 65536 then
     426              result := ec2
     427            else
     428              result := InterpolateToExpanded(position);
     429          end;
     430  grRepeat: result := InterpolateToExpanded(position and $ffff);
     431  grReflect:
     432    begin
     433      position := position and $1ffff;
     434      if position >= $10000 then
     435      begin
     436        if position = $10000 then
     437          result := ec2
     438        else
     439          result := InterpolateToExpanded($20000 - position);
     440      end
     441      else
     442        result := InterpolateToExpanded(position);
     443    end;
     444  else
     445    begin
     446      if position <= 0 then
     447        result := ec1 else
     448      if position >= 65536 then
     449        result := ec2 else
     450        result := InterpolateToExpanded(position);
     451    end;
     452  end;
     453end;
     454
     455function TBGRASimpleGradient.GetExpandedColorAtF(position: single
     456  ): TExpandedPixel;
     457begin
     458  if FRepetition <> grPad then
     459    result := GetExpandedColorAt(round(frac(position*0.5)*131072)) else  //divided by 2 for reflected repetition
     460  begin
     461    if position <= 0 then
     462      result := ec1 else
     463    if position >= 1 then
     464      result := ec2 else
     465      result := GetExpandedColorAt(round(position*65536));
     466  end;
     467end;
     468
     469function TBGRASimpleGradient.GetMonochrome: boolean;
     470begin
     471  Result:= (FColor1 = FColor2);
     472end;
     473
    233474{ TBGRAConstantScanner }
    234475
    … …  
    244485  FGrayscale:= AGrayscale;
    245486  FOpacity:= AOpacity;
     487  FRandomBufferCount := 0;
    246488end;
    247489
    … …  
    252494
    253495function TBGRARandomScanner.ScanNextPixel: TBGRAPixel;
     496var rgb: integer;
    254497begin
    255498  if FGrayscale then
    256499  begin
    257     result.red := random(256);
     500    if FRandomBufferCount = 0 then
     501    begin
     502      FRandomBuffer := random(256*256*256);
     503      FRandomBufferCount := 3;
     504    end;
     505    result.red := FRandomBuffer and 255;
     506    FRandomBuffer:= FRandomBuffer shr 8;
     507    FRandomBufferCount -= 1;
    258508    result.green := result.red;
    259509    result.blue := result.red;
    260510    result.alpha:= FOpacity;
    261511  end else
    262     Result:= BGRA(random(256),random(256),random(256),FOpacity);
     512  begin
     513    rgb := random(256*256*256);
     514    Result:= BGRA(rgb and 255,(rgb shr 8) and 255,(rgb shr 16) and 255,FOpacity);
     515  end;
    263516end;
    264517
    … …  
    272525procedure TBGRAHueGradient.Init(c1, c2: THSLAPixel; AOptions: THueGradientOptions);
    273526begin
    274   FColor1 := HSLAToBGRA(c1);
    275   FColor2 := HSLAToBGRA(c2);
    276   ec1 := GammaExpansion(FColor1);
    277   ec2 := GammaExpansion(FColor2);
    278527  FOptions:= AOptions;
    279528  if (hgoLightnessCorrection in AOptions) then
    280529  begin
    281     hsla1 := BGRAToGSBA(FColor1);
    282     hsla2 := BGRAToGSBA(FColor2);
     530    hsla1 := ExpandedToGSBA(ec1);
     531    hsla2 := ExpandedToGSBA(ec2);
    283532  end else
    284533  begin
    … …  
    305554end;
    306555
    307 function TBGRAHueGradient.GetColorNoBoundCheck(position: integer): THSLAPixel;
     556function TBGRAHueGradient.InterpolateToHSLA(position: word): THSLAPixel;
    308557var b,b2: LongWord;
    309558begin
    … …  
    325574end;
    326575
     576function TBGRAHueGradient.InterpolateToBGRA(position: word): TBGRAPixel;
     577begin
     578  if hgoLightnessCorrection in FOptions then
     579    result := GSBAToBGRA(InterpolateToHSLA(position))
     580  else
     581    result := HSLAToBGRA(InterpolateToHSLA(position));
     582end;
     583
     584function TBGRAHueGradient.InterpolateToExpanded(position: word): TExpandedPixel;
     585begin
     586  if hgoLightnessCorrection in FOptions then
     587    result := GSBAToExpanded(InterpolateToHSLA(position))
     588  else
     589    result := HSLAToExpanded(InterpolateToHSLA(position));
     590end;
     591
    327592constructor TBGRAHueGradient.Create(Color1, Color2: TBGRAPixel;options: THueGradientOptions);
    328593begin
     594  if hgoReflect in options then
     595    inherited Create(Color1,Color2,grReflect)
     596  else if hgoRepeat in options then
     597    inherited Create(Color1,Color2,grRepeat)
     598  else
     599    inherited Create(Color1,Color2,grPad);
     600
    329601  Init(BGRAToHSLA(Color1),BGRAToHSLA(Color2),options);
    330602end;
    331603
     604constructor TBGRAHueGradient.Create(Color1, Color2: TExpandedPixel;
     605  options: THueGradientOptions);
     606begin
     607  if hgoReflect in options then
     608    inherited Create(Color1,Color2,grReflect)
     609  else if hgoRepeat in options then
     610    inherited Create(Color1,Color2,grRepeat)
     611  else
     612    inherited Create(Color1,Color2,grPad);
     613
     614  Init(ExpandedToHSLA(Color1),ExpandedToHSLA(Color2),options);
     615end;
     616
    332617constructor TBGRAHueGradient.Create(Color1, Color2: THSLAPixel; options: THueGradientOptions);
    333618begin
     619  if hgoReflect in options then
     620    inherited Create(Color1.ToExpanded,Color2.ToExpanded,grReflect)
     621  else if hgoRepeat in options then
     622    inherited Create(Color1.ToExpanded,Color2.ToExpanded,grRepeat)
     623  else
     624    inherited Create(Color1.ToExpanded,Color2.ToExpanded,grPad);
     625
    334626  Init(Color1,Color2, options);
    335627end;
    … …  
    338630  Lightness: Word; options: THueGradientOptions);
    339631begin
    340   Init(HSLA(AHue1,saturation,lightness), HSLA(AHue2,saturation,lightness), options);
    341 end;
    342 
    343 function TBGRAHueGradient.GetColorAt(position: integer): TBGRAPixel;
    344 var interm: THSLAPixel;
    345 begin
    346   if hgoRepeat in FOptions then
    347   begin
    348     position := position and $ffff;
    349     if position = 0 then
    350     begin
    351       result := FColor1;
    352       exit;
    353     end;
    354   end else
    355   begin
    356     if position <= 0 then
    357     begin
    358       result := FColor1;
    359       exit
    360     end else
    361     if position >= 65536 then
    362     begin
    363       result := FColor2;
    364       exit
    365     end;
    366   end;
    367   interm := GetColorNoBoundCheck(position);
    368   if hgoLightnessCorrection in FOptions then
    369     result := GSBAToBGRA(interm)
    370   else
    371     result := HSLAToBGRA(interm);
    372 end;
    373 
    374 function TBGRAHueGradient.GetColorAtF(position: single): TBGRAPixel;
    375 var interm: THSLAPixel;
    376 begin
    377   if hgoRepeat in FOptions then
    378   begin
    379     position := frac(position);
    380     if position = 0 then
    381     begin
    382       result := FColor1;
    383       exit;
    384     end;
    385   end else
    386   begin
    387     if position <= 0 then
    388     begin
    389       result := FColor1;
    390       exit;
    391     end else
    392     if position >= 1 then
    393     begin
    394       result := FColor2;
    395       exit
    396     end;
    397   end;
    398   interm := GetColorNoBoundCheck(round(position*65536));
    399   if hgoLightnessCorrection in FOptions then
    400     result := GSBAToBGRA(interm)
    401   else
    402     result := HSLAToBGRA(interm);
    403 end;
    404 
    405 function TBGRAHueGradient.GetAverageColor: TBGRAPixel;
    406 begin
    407   Result:= GetColorAt(32768);
    408 end;
    409 
    410 function TBGRAHueGradient.GetExpandedColorAt(position: integer): TExpandedPixel;
    411 var interm: THSLAPixel;
    412 begin
    413   if hgoRepeat in FOptions then
    414   begin
    415     position := position and $ffff;
    416     if position = 0 then
    417     begin
    418       result := ec1;
    419       exit;
    420     end;
    421   end else
    422   begin
    423     if position <= 0 then
    424     begin
    425       result := ec1;
    426       exit
    427     end else
    428     if position >= 65536 then
    429     begin
    430       result := ec2;
    431       exit
    432     end;
    433   end;
    434   interm := GetColorNoBoundCheck(position);
    435   if hgoLightnessCorrection in FOptions then
    436     result := GSBAToExpanded(interm)
    437   else
    438     result := HSLAToExpanded(interm);
    439 end;
    440 
    441 function TBGRAHueGradient.GetExpandedColorAtF(position: single): TExpandedPixel;
    442 var interm: THSLAPixel;
    443 begin
    444   if hgoRepeat in FOptions then
    445   begin
    446     position := frac(position);
    447     if position = 0 then
    448     begin
    449       result := ec1;
    450       exit;
    451     end;
    452   end else
    453   begin
    454     if position <= 0 then
    455     begin
    456       result := ec1;
    457       exit;
    458     end else
    459     if position >= 1 then
    460     begin
    461       result := ec2;
    462       exit
    463     end;
    464   end;
    465   interm := GetColorNoBoundCheck(round(position*65536));
    466   if hgoLightnessCorrection in FOptions then
    467     result := GSBAToExpanded(interm)
    468   else
    469     result := HSLAToExpanded(interm);
    470 end;
    471 
    472 function TBGRAHueGradient.GetAverageExpandedColor: TExpandedPixel;
    473 begin
    474   Result:= GetExpandedColorAt(32768);
     632  Create(HSLA(AHue1,saturation,lightness), HSLA(AHue2,saturation,lightness), options);
    475633end;
    476634
    … …  
    670828{ TBGRASimpleGradientWithGammaCorrection }
    671829
    672 constructor TBGRASimpleGradientWithGammaCorrection.Create(Color1,
    673   Color2: TBGRAPixel);
    674 begin
    675   FColor1 := Color1;
    676   FColor2 := Color2;
    677   ec1 := GammaExpansion(Color1);
    678   ec2 := GammaExpansion(Color2);
    679 end;
    680 
    681 function TBGRASimpleGradientWithGammaCorrection.GetColorAt(position: integer
     830function TBGRASimpleGradientWithGammaCorrection.InterpolateToBGRA(position: word
    682831  ): TBGRAPixel;
    683832var b,b2: cardinal;
    684833    ec: TExpandedPixel;
    685834begin
    686   if position <= 0 then
    687     result := FColor1 else
    688   if position >= 65536 then
    689     result := FColor2 else
    690   begin
    691     b      := position;
    692     b2     := 65536-b;
    693     ec.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16;
    694     ec.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16;
    695     ec.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16;
    696     ec.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16;
    697     result := GammaCompression(ec);
    698   end;
    699 end;
    700 
    701 function TBGRASimpleGradientWithGammaCorrection.GetColorAtF(position: single): TBGRAPixel;
     835  b      := position;
     836  b2     := 65536-b;
     837  ec.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16;
     838  ec.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16;
     839  ec.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16;
     840  ec.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16;
     841  result := GammaCompression(ec);
     842end;
     843
     844function TBGRASimpleGradientWithGammaCorrection.InterpolateToExpanded(
     845  position: word): TExpandedPixel;
    702846var b,b2: cardinal;
    703     ec: TExpandedPixel;
    704 begin
    705   if position <= 0 then
    706     result := FColor1 else
    707   if position >= 1 then
    708     result := FColor2 else
    709   begin
    710     b      := round(position*65536);
    711     b2     := 65536-b;
    712     ec.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16;
    713     ec.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16;
    714     ec.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16;
    715     ec.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16;
    716     result := GammaCompression(ec);
    717   end;
    718 end;
    719 
    720 function TBGRASimpleGradientWithGammaCorrection.GetAverageColor: TBGRAPixel;
    721 begin
    722   result := GammaCompression(MergeBGRA(ec1,ec2));
    723 end;
    724 
    725 function TBGRASimpleGradientWithGammaCorrection.GetExpandedColorAt(
    726   position: integer): TExpandedPixel;
     847begin
     848  b      := position;
     849  b2     := 65536-b;
     850  result.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16;
     851  result.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16;
     852  result.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16;
     853  result.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16;
     854end;
     855
     856constructor TBGRASimpleGradientWithGammaCorrection.Create(Color1,
     857  Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition);
     858begin
     859  inherited Create(Color1,Color2,ARepetition);
     860end;
     861
     862constructor TBGRASimpleGradientWithGammaCorrection.Create(Color1,
     863  Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition);
     864begin
     865  inherited Create(Color1,Color2,ARepetition);
     866end;
     867
     868{ TBGRASimpleGradientWithoutGammaCorrection }
     869
     870function TBGRASimpleGradientWithoutGammaCorrection.InterpolateToBGRA(
     871  position: word): TBGRAPixel;
    727872var b,b2: cardinal;
    728873begin
    729   if position <= 0 then
    730     result := ec1 else
    731   if position >= 65536 then
    732     result := ec2 else
    733   begin
    734     b      := position;
    735     b2     := 65536-b;
    736     result.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16;
    737     result.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16;
    738     result.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16;
    739     result.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16;
    740   end;
    741 end;
    742 
    743 function TBGRASimpleGradientWithGammaCorrection.GetExpandedColorAtF(
    744   position: single): TExpandedPixel;
    745 var b,b2: cardinal;
    746 begin
    747   if position <= 0 then
    748     result := ec1 else
    749   if position >= 1 then
    750     result := ec2 else
    751   begin
    752     b      := round(position*65536);
    753     b2     := 65536-b;
    754     result.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16;
    755     result.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16;
    756     result.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16;
    757     result.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16;
    758   end;
    759 end;
    760 
    761 function TBGRASimpleGradientWithGammaCorrection.GetAverageExpandedColor: TExpandedPixel;
    762 begin
    763   result := MergeBGRA(ec1,ec2);
    764 end;
    765 
    766 function TBGRASimpleGradientWithGammaCorrection.GetMonochrome: boolean;
    767 begin
    768   Result:= (FColor1 = FColor2);
    769 end;
    770 
    771 { TBGRASimpleGradientWithoutGammaCorrection }
    772 
    773 constructor TBGRASimpleGradientWithoutGammaCorrection.Create(Color1,
    774   Color2: TBGRAPixel);
    775 begin
    776   FColor1 := Color1;
    777   FColor2 := Color2;
    778   ec1 := GammaExpansion(Color1);
    779   ec2 := GammaExpansion(Color2);
    780 end;
    781 
    782 function TBGRASimpleGradientWithoutGammaCorrection.GetColorAt(position: integer
    783   ): TBGRAPixel;
    784 var b,b2: cardinal;
    785 begin
    786   if position <= 0 then
    787     result := FColor1 else
    788   if position >= 65536 then
    789     result := FColor2 else
    790   begin
    791     b      := position shr 6;
    792     b2     := 1024-b;
    793     result.red  := (FColor1.red * b2 + FColor2.red * b + 511) shr 10;
    794     result.green := (FColor1.green * b2 + FColor2.green * b + 511) shr 10;
    795     result.blue := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 10;
    796     result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 10;
    797   end;
    798 end;
    799 
    800 function TBGRASimpleGradientWithoutGammaCorrection.GetColorAtF(position: single): TBGRAPixel;
    801 begin
    802   if position <= 0 then
    803     result := FColor1 else
    804   if position >= 1 then
    805     result := FColor2 else
    806     result := GetColorAt(round(position*65536));
    807 end;
    808 
    809 function TBGRASimpleGradientWithoutGammaCorrection.GetExpandedColorAt(
    810   position: integer): TExpandedPixel;
     874  b      := position shr 6;
     875  b2     := 1024-b;
     876  result.red  := (FColor1.red * b2 + FColor2.red * b + 511) shr 10;
     877  result.green := (FColor1.green * b2 + FColor2.green * b + 511) shr 10;
     878  result.blue := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 10;
     879  result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 10;
     880end;
     881
     882function TBGRASimpleGradientWithoutGammaCorrection.InterpolateToExpanded(
     883  position: word): TExpandedPixel;
    811884var b,b2: cardinal;
    812885    rw,gw,bw: word;
    813886begin
    814   if position <= 0 then
    815     result := ec1 else
    816   if position >= 65536 then
    817     result := ec2 else
    818   begin
    819     b      := position shr 6;
    820     b2     := 1024-b;
    821     rw  := (FColor1.red * b2 + FColor2.red * b + 511) shr 2;
    822     gw := (FColor1.green * b2 + FColor2.green * b + 511) shr 2;
    823     bw := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 2;
    824 
     887  b      := position shr 6;
     888  b2     := 1024-b;
     889  rw  := (FColor1.red * b2 + FColor2.red * b + 511) shr 2;
     890  gw := (FColor1.green * b2 + FColor2.green * b + 511) shr 2;
     891  bw := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 2;
     892
     893  if rw >= $ff00 then
     894    result.red := 65535
     895  else
    825896    result.red := (GammaExpansionTab[rw shr 8]*NativeUInt(255 - (rw and 255)) + GammaExpansionTab[(rw shr 8)+1]*NativeUInt(rw and 255)) shr 8;
     897
     898  if gw >= $ff00 then
     899    result.green := 65535
     900  else
    826901    result.green := (GammaExpansionTab[gw shr 8]*NativeUInt(255 - (gw and 255)) + GammaExpansionTab[(gw shr 8)+1]*NativeUInt(gw and 255)) shr 8;
     902
     903  if bw >= $ff00 then
     904    result.blue := 65535
     905  else
    827906    result.blue := (GammaExpansionTab[bw shr 8]*NativeUInt(255 - (bw and 255)) + GammaExpansionTab[(bw shr 8)+1]*NativeUInt(bw and 255)) shr 8;
    828     result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 2;
    829   end;
    830 end;
    831 
    832 function TBGRASimpleGradientWithoutGammaCorrection.GetExpandedColorAtF(
    833   position: single): TExpandedPixel;
    834 begin
    835   if position <= 0 then
    836     result := ec1 else
    837   if position >= 1 then
    838     result := ec2 else
    839     result := GetExpandedColorAt(round(position*65536));
    840 end;
    841 
    842 function TBGRASimpleGradientWithoutGammaCorrection.GetAverageColor: TBGRAPixel;
    843 begin
    844   result := MergeBGRA(FColor1,FColor2);
    845 end;
    846 
    847 function TBGRASimpleGradientWithoutGammaCorrection.GetMonochrome: boolean;
    848 begin
    849   Result:= (FColor1 = FColor2);
     907
     908  result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 2;
     909end;
     910
     911constructor TBGRASimpleGradientWithoutGammaCorrection.Create(Color1,
     912  Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition);
     913begin
     914  inherited Create(Color1,Color2,ARepetition);
     915end;
     916
     917constructor TBGRASimpleGradientWithoutGammaCorrection.Create(Color1,
     918  Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition);
     919begin
     920  inherited Create(Color1,Color2,ARepetition);
    850921end;
    851922
    … …  
    9461017{ TBGRAGradientScanner }
    9471018
    948 procedure TBGRAGradientScanner.Init(gtype: TGradientType; o1, o2: TPointF;
    949   Sinus: Boolean);
    950 begin
    951   FGradientType:= gtype;
    952   FOrigin1 := o1;
    953   FOrigin2 := o2;
     1019procedure TBGRAGradientScanner.SetTransform(AValue: TAffineMatrix);
     1020begin
     1021  if FTransform=AValue then Exit;
     1022  FTransform:=AValue;
     1023  InitTransform;
     1024end;
     1025
     1026constructor TBGRAGradientScanner.Create(AGradientType: TGradientType; AOrigin, d1: TPointF);
     1027begin
     1028  FGradient := nil;
     1029  SetGradient(BGRABlack,BGRAWhite,False);
     1030  Init(AGradientType,AOrigin,d1,AffineMatrixIdentity,False);
     1031end;
     1032
     1033constructor TBGRAGradientScanner.Create(AGradientType: TGradientType; AOrigin, d1,d2: TPointF);
     1034begin
     1035  FGradient := nil;
     1036  SetGradient(BGRABlack,BGRAWhite,False);
     1037  Init(AGradientType,AOrigin,d1,d2,AffineMatrixIdentity,False);
     1038end;
     1039
     1040constructor TBGRAGradientScanner.Create(AOrigin,
     1041  d1, d2, AFocal: TPointF; ARadiusRatio: single; AFocalRadiusRatio: single);
     1042var
     1043  m, mInv: TAffineMatrix;
     1044  focalInv: TPointF;
     1045begin
     1046  FGradient := nil;
     1047  SetGradient(BGRABlack,BGRAWhite,False);
     1048
     1049  m := AffineMatrix((d1-AOrigin).x, (d2-AOrigin).x, AOrigin.x,
     1050                    (d1-AOrigin).y, (d2-AOrigin).y, AOrigin.y);
     1051  if IsAffineMatrixInversible(m) then
     1052  begin
     1053    mInv := AffineMatrixInverse(m);
     1054    focalInv := mInv*AFocal;
     1055  end else
     1056    focalInv := PointF(0,0);
     1057
     1058  Init(PointF(0,0), ARadiusRatio, focalInv, AFocalRadiusRatio, AffineMatrixIdentity, m);
     1059end;
     1060
     1061constructor TBGRAGradientScanner.Create(AOrigin: TPointF; ARadius: single;
     1062  AFocal: TPointF; AFocalRadius: single);
     1063begin
     1064  FGradient := nil;
     1065  SetGradient(BGRABlack,BGRAWhite,False);
     1066
     1067  Init(AOrigin, ARadius, AFocal, AFocalRadius, AffineMatrixIdentity, AffineMatrixIdentity);
     1068end;
     1069
     1070procedure TBGRAGradientScanner.SetFlipGradient(AValue: boolean);
     1071begin
     1072  if FFlipGradient=AValue then Exit;
     1073  FFlipGradient:=AValue;
     1074end;
     1075
     1076function TBGRAGradientScanner.GetGradientColor(a: single): TBGRAPixel;
     1077begin
     1078  if a = EmptySingle then
     1079    result := BGRAPixelTransparent
     1080  else
     1081  begin
     1082    if FFlipGradient then a := 1-a;
     1083    if FSinus then
     1084    begin
     1085      a := a*65536;
     1086      if (a <= low(int64)) or (a >= high(int64)) then
     1087        result := FAverageColor
     1088      else
     1089        result := FGradient.GetColorAt(Sin65536(round(a) and 65535));
     1090    end else
     1091      result := FGradient.GetColorAtF(a);
     1092  end;
     1093end;
     1094
     1095function TBGRAGradientScanner.GetGradientExpandedColor(a: single): TExpandedPixel;
     1096begin
     1097  if a = EmptySingle then
     1098    QWord(result) := 0
     1099  else
     1100  begin
     1101    if FFlipGradient then a := 1-a;
     1102    if FSinus then
     1103    begin
     1104      a *= 65536;
     1105      if (a <= low(int64)) or (a >= high(int64)) then
     1106        result := FAverageExpandedColor
     1107      else
     1108        result := FGradient.GetExpandedColorAt(Sin65536(round(a) and 65535));
     1109    end else
     1110      result := FGradient.GetExpandedColorAtF(a);
     1111  end;
     1112end;
     1113
     1114procedure TBGRAGradientScanner.Init(AGradientType: TGradientType; AOrigin, d1: TPointF;
     1115  ATransform: TAffineMatrix; Sinus: Boolean);
     1116var d2: TPointF;
     1117begin
     1118  with (d1-AOrigin) do
     1119    d2 := PointF(AOrigin.x+y,AOrigin.y-x);
     1120  Init(AGradientType,AOrigin,d1,d2,ATransform,Sinus);
     1121end;
     1122
     1123procedure TBGRAGradientScanner.Init(AGradientType: TGradientType; AOrigin, d1, d2: TPointF;
     1124  ATransform: TAffineMatrix; Sinus: Boolean);
     1125begin
     1126  FGradientType:= AGradientType;
     1127  FFlipGradient:= false;
     1128  FOrigin := AOrigin;
     1129  FDir1 := d1;
     1130  FDir2 := d2;
    9541131  FSinus := Sinus;
    955 
    956   //compute vector
    957   u.x := o2.x - o1.x;
    958   u.y := o2.y - o1.y;
    959   len := sqrt(sqr(u.x) + sqr(u.y));
    960   if len <> 0 then
    961   begin
    962     u.x /= len;
    963     u.y /= len;
    964     aFactor := 65536/len;
    965     aFactorF := 1/len;
    966   end
    967   else
    968   begin
    969     aFactor := 0;
    970     aFactorF := 0;
    971   end;
    972 
    973   FVertical := (((gtype =gtLinear) or (gtype=gtReflected)) and (o1.x=o2.x)) or FGradient.Monochrome;
    974   mergedColor := FGradient.GetAverageColor;
    975   mergedExpandedColor := FGradient.GetAverageExpandedColor;
    976 end;
    977 
    978 procedure TBGRAGradientScanner.InitScanInline(x, y: integer);
    979 var p: TPointF;
    980 begin
    981   p.x := X - FOrigin1.x;
    982   p.y := Y - FOrigin1.y;
    983   FDotProduct := p.x * u.x + p.y * u.y;
    984   FDotProductPerp := p.x * u.y - p.y * u.x;
    985 end;
    986 
    987 function TBGRAGradientScanner.ScanNextInline: TBGRAPixel;
    988 var
    989   a,a2: single;
    990   ai: integer;
    991 begin
    992   if FGradientType >= gtDiamond then
    993   begin
    994     if FGradientType = gtRadial then
     1132  FTransform := ATransform;
     1133  FHiddenTransform := AffineMatrixIdentity;
     1134
     1135  FRadius := 1;
     1136  FRelativeFocal := PointF(0,0);
     1137  FFocalRadius := 0;
     1138
     1139  InitGradientType;
     1140  InitTransform;
     1141end;
     1142
     1143procedure TBGRAGradientScanner.Init(AOrigin: TPointF; ARadius: single;
     1144  AFocal: TPointF; AFocalRadius: single; ATransform: TAffineMatrix; AHiddenTransform: TAffineMatrix);
     1145var maxRadius: single;
     1146begin
     1147  FGradientType:= gtRadial;
     1148  FFlipGradient:= false;
     1149  FOrigin := AOrigin;
     1150  ARadius := abs(ARadius);
     1151  AFocalRadius := abs(AFocalRadius);
     1152  maxRadius := max(ARadius,AFocalRadius);
     1153  FDir1 := AOrigin+PointF(maxRadius,0);
     1154  FDir2 := AOrigin+PointF(0,maxRadius);
     1155  FSinus := False;
     1156  FTransform := ATransform;
     1157  FHiddenTransform := AHiddenTransform;
     1158
     1159  FRadius := ARadius/maxRadius;
     1160  FRelativeFocal := (AFocal - AOrigin)*(1/maxRadius);
     1161  FFocalRadius := AFocalRadius/maxRadius;
     1162
     1163  InitGradientType;
     1164  InitTransform;
     1165end;
     1166
     1167procedure TBGRAGradientScanner.InitGradientType;
     1168begin
     1169  case FGradientType of
     1170    gtReflected: begin
     1171      FScanNextFunc:= @ScanNextReflected;
     1172      FScanAtFunc:= @ScanAtReflected;
     1173    end;
     1174    gtDiamond: begin
     1175      FScanNextFunc:= @ScanNextDiamond;
     1176      FScanAtFunc:= @ScanAtDiamond;
     1177    end;
     1178    gtRadial: if (FRelativeFocal.x = 0) and (FRelativeFocal.y = 0) then
    9951179    begin
    996       a := sqrt(sqr(FDotProduct) + sqr(FDotProductPerp));
    997       FDotProduct += u.x;
    998       FDotProductPerp += u.y;
     1180      if (FFocalRadius = 0) and (FRadius = 1) then
     1181      begin
     1182        FScanNextFunc:= @ScanNextRadial;
     1183        FScanAtFunc:= @ScanAtRadial;
     1184      end else
     1185      begin
     1186        FScanNextFunc:= @ScanNextRadial2;
     1187        FScanAtFunc:= @ScanAtRadial2;
     1188      end;
    9991189    end else
    10001190    begin
    1001       a   := abs(FDotProduct);
    1002       a2  := abs(FDotProductPerp);
    1003       if a2 > a then a := a2;
    1004       FDotProduct += u.x;
    1005       FDotProductPerp += u.y;
     1191      FScanNextFunc:= @ScanNextRadialFocal;
     1192      FScanAtFunc:= @ScanAtRadialFocal;
     1193
     1194      FFocalDirection := FRelativeFocal;
     1195      FFocalDistance := VectLen(FFocalDirection);
     1196      if FFocalDistance > 0 then FFocalDirection *= 1/FFocalDistance;
     1197      FFocalNormal := PointF(-FFocalDirection.y,FFocalDirection.x);
     1198      FRadialDenominator := sqr(FRadius-FFocalRadius)-sqr(FFocalDistance);
     1199
     1200      //case in which the second circle is bigger and the first circle is within the second
     1201      if (FRadius < FFocalRadius) and (FFocalDistance <= FFocalRadius-FRadius) then
     1202        FRadialDeltaSign := -1
     1203      else
     1204        FRadialDeltaSign := 1;
     1205
     1206      //clipping afer the apex
     1207      if (FFocalRadius < FRadius) and (FFocalDistance > FRadius-FFocalRadius) then
     1208      begin
     1209        maxW1 := FRadius/(FRadius-FFocalRadius)*FFocalDistance;
     1210        maxW2 := MaxSingle;
     1211      end else
     1212      if (FRadius < FFocalRadius) and (FFocalDistance > FFocalRadius-FRadius) then
     1213      begin
     1214        maxW1 := MaxSingle;
     1215        maxW2 := FFocalRadius/(FFocalRadius-FRadius)*FFocalDistance;
     1216      end else
     1217      begin
     1218        maxW1 := MaxSingle;
     1219        maxW2 := MaxSingle;
     1220      end;
    10061221    end;
    1007   end else
    1008   if FGradientType = gtReflected then
    1009   begin
    1010     a := abs(FDotProduct);
    1011     FDotProduct += u.x;
    1012   end else
    1013   begin
    1014     a := FDotProduct;
    1015     FDotProduct += u.x;
    1016   end;
    1017 
    1018   if FSinus then
    1019   begin
    1020     a *= aFactor;
    1021     if a <= low(int64) then
    1022       result := FGradient.GetAverageColor
    1023     else
    1024     if a >= high(int64) then
    1025       result := FGradient.GetAverageColor
    1026     else
    1027     begin
    1028       ai := Sin65536(round(a));
    1029       result := FGradient.GetColorAt(ai);
     1222    gtAngular: begin
     1223      FScanNextFunc:= @ScanNextAngular;
     1224      FScanAtFunc:= @ScanAtAngular;
    10301225    end;
    1031   end else
    1032     result := FGradient.GetColorAtF(a*aFactorF);
    1033 end;
    1034 
    1035 function TBGRAGradientScanner.ScanNextExpandedInline: TExpandedPixel;
    1036 var
    1037   a,a2: single;
    1038   ai: integer;
    1039 begin
    1040   if FGradientType >= gtDiamond then
    1041   begin
    1042     if FGradientType = gtRadial then
    1043     begin
    1044       a := sqrt(sqr(FDotProduct) + sqr(FDotProductPerp));
    1045       FDotProduct += u.x;
    1046       FDotProductPerp += u.y;
    1047     end else
    1048     begin
    1049       a   := abs(FDotProduct);
    1050       a2  := abs(FDotProductPerp);
    1051       if a2 > a then a := a2;
    1052       FDotProduct += u.x;
    1053       FDotProductPerp += u.y;
     1226  else
     1227    {gtLinear:} begin
     1228      FScanNextFunc:= @ScanNextLinear;
     1229      FScanAtFunc:= @ScanAtLinear;
    10541230    end;
    1055   end else
    1056   if FGradientType = gtReflected then
    1057   begin
    1058     a := abs(FDotProduct);
    1059     FDotProduct += u.x;
    1060   end else
    1061   begin
    1062     a := FDotProduct;
    1063     FDotProduct += u.x;
    1064   end;
    1065 
    1066   if FSinus then
    1067   begin
    1068     a *= aFactor;
    1069     if a <= low(int64) then
    1070       result := FGradient.GetAverageExpandedColor
    1071     else
    1072     if a >= high(int64) then
    1073       result := FGradient.GetAverageExpandedColor
    1074     else
    1075     begin
    1076       ai := Sin65536(round(a));
    1077       result := FGradient.GetExpandedColorAt(ai);
    1078     end;
    1079   end else
    1080     result := FGradient.GetExpandedColorAtF(a*aFactorF);
    1081 end;
    1082 
    1083 constructor TBGRAGradientScanner.Create(c1, c2: TBGRAPixel;
    1084   gtype: TGradientType; o1, o2: TPointF; gammaColorCorrection: boolean;
    1085   Sinus: Boolean);
    1086 begin
     1231  end;
     1232end;
     1233
     1234procedure TBGRAGradientScanner.SetGradient(c1, c2: TBGRAPixel;
     1235  AGammaCorrection: boolean);
     1236begin
     1237  if Assigned(FGradient) and FGradientOwner then FreeAndNil(FGradient);
     1238
    10871239  //transparent pixels have no color so
    10881240  //take it from other color
    1089   if c1.alpha = 0 then
    1090   begin
    1091     c1.red   := c2.red;
    1092     c1.green := c2.green;
    1093     c1.blue  := c2.blue;
    1094   end
    1095   else
    1096   if c2.alpha = 0 then
    1097   begin
    1098     c2.red   := c1.red;
    1099     c2.green := c1.green;
    1100     c2.blue  := c1.blue;
    1101   end;
    1102 
    1103   if gammaColorCorrection then
    1104   begin
    1105     FGradient := TBGRASimpleGradientWithGammaCorrection.Create(c1,c2);
    1106     FGradientOwner := true;
     1241  if c1.alpha = 0 then c1 := BGRA(c2.red,c2.green,c2.blue,0);
     1242  if c2.alpha = 0 then c2 := BGRA(c1.red,c1.green,c1.blue,0);
     1243
     1244  if AGammaCorrection then
     1245    FGradient := TBGRASimpleGradientWithGammaCorrection.Create(c1,c2)
     1246  else
     1247    FGradient := TBGRASimpleGradientWithoutGammaCorrection.Create(c1,c2);
     1248  FGradientOwner := true;
     1249  InitGradient;
     1250end;
     1251
     1252procedure TBGRAGradientScanner.SetGradient(AGradient: TBGRACustomGradient;
     1253  AOwner: boolean);
     1254begin
     1255  if Assigned(FGradient) and FGradientOwner then FreeAndNil(FGradient);
     1256  FGradient := AGradient;
     1257  FGradientOwner := AOwner;
     1258  InitGradient;
     1259end;
     1260
     1261procedure TBGRAGradientScanner.InitTransform;
     1262var u,v: TPointF;
     1263begin
     1264  u := FDir1-FOrigin;
     1265  if FGradientType in[gtLinear,gtReflected] then
     1266    v := PointF(u.y, -u.x)
     1267  else
     1268    v := FDir2-FOrigin;
     1269
     1270  FMatrix := FTransform * FHiddenTransform * AffineMatrix(u.x, v.x, FOrigin.x,
     1271                                                          u.y, v.y, FOrigin.y);
     1272  if IsAffineMatrixInversible(FMatrix) then
     1273  begin
     1274    FMatrix := AffineMatrixInverse(FMatrix);
     1275    FIsAverage:= false;
    11071276  end else
    11081277  begin
    1109     FGradient := TBGRASimpleGradientWithoutGammaCorrection.Create(c1,c2);
    1110     FGradientOwner := true;
    1111   end;
    1112   Init(gtype,o1,o2,Sinus);
     1278    FMatrix := AffineMatrixIdentity;
     1279    FIsAverage:= true;
     1280  end;
     1281
     1282  case FGradientType of
     1283    gtReflected: FRepeatHoriz := (FMatrix[1,1]=0);
     1284    gtDiamond,gtAngular: FRepeatHoriz:= FIsAverage;
     1285    gtRadial: begin
     1286      if FFocalRadius = FRadius then FIsAverage:= true;
     1287      FRepeatHoriz:= FIsAverage;
     1288    end
     1289  else
     1290    {gtLinear:} FRepeatHoriz := (FMatrix[1,1]=0);
     1291  end;
     1292
     1293  if FGradient.Monochrome then
     1294  begin
     1295    FRepeatHoriz:= true;
     1296    FIsAverage:= true;
     1297  end;
     1298
     1299  FPosition := PointF(0,0);
     1300end;
     1301
     1302procedure TBGRAGradientScanner.InitGradient;
     1303begin
     1304  FAverageColor := FGradient.GetAverageColor;
     1305  FAverageExpandedColor := FGradient.GetAverageExpandedColor;
     1306end;
     1307
     1308function TBGRAGradientScanner.ComputeRadialFocal(const p: TPointF): single;
     1309var
     1310  w1,w2,h,d1,d2,delta,num: single;
     1311begin
     1312  w1 := p*FFocalDirection;
     1313  w2 := FFocalDistance-w1;
     1314  if (w1 < maxW1) and (w2 < maxW2) then
     1315  begin
     1316    //vertical position and distances
     1317    h := sqr(p*FFocalNormal);
     1318    d1 := sqr(w1)+h;
     1319    d2 := sqr(w2)+h;
     1320    //finding t
     1321    delta := sqr(FFocalRadius)*d1 + 2*FRadius*FFocalRadius*(p*(FRelativeFocal-p))+
     1322             sqr(FRadius)*d2 - sqr(VectDet(p,FRelativeFocal));
     1323    if delta >= 0 then
     1324    begin
     1325      num := -FFocalRadius*(FRadius-FFocalRadius)-(FRelativeFocal*(FRelativeFocal-p));
     1326      result := (num+FRadialDeltaSign*sqrt(delta))/FRadialDenominator;
     1327    end else
     1328      result := EmptySingle;
     1329  end else
     1330    result := EmptySingle;
     1331end;
     1332
     1333function TBGRAGradientScanner.ScanNextLinear: single;
     1334begin
     1335  result := FPosition.x;
     1336end;
     1337
     1338function TBGRAGradientScanner.ScanNextReflected: single;
     1339begin
     1340  result := abs(FPosition.x);
     1341end;
     1342
     1343function TBGRAGradientScanner.ScanNextDiamond: single;
     1344begin
     1345  result := max(abs(FPosition.x), abs(FPosition.y));
     1346end;
     1347
     1348function TBGRAGradientScanner.ScanNextRadial: single;
     1349begin
     1350  result := sqrt(sqr(FPosition.x) + sqr(FPosition.y));
     1351end;
     1352
     1353function TBGRAGradientScanner.ScanNextRadial2: single;
     1354begin
     1355  result := (sqrt(sqr(FPosition.x) + sqr(FPosition.y))-FFocalRadius)/(FRadius-FFocalRadius);
     1356end;
     1357
     1358function TBGRAGradientScanner.ScanNextRadialFocal: single;
     1359begin
     1360  result := ComputeRadialFocal(FPosition);
     1361end;
     1362
     1363function TBGRAGradientScanner.ScanNextAngular: single;
     1364begin
     1365  if FPosition.y >= 0 then
     1366    result := arctan2(FPosition.y,FPosition.x)/(2*Pi)
     1367  else
     1368    result := 1-arctan2(-FPosition.y,FPosition.x)/(2*Pi)
     1369end;
     1370
     1371function TBGRAGradientScanner.ScanAtLinear(const p: TPointF): single;
     1372begin
     1373  with (FMatrix*p) do
     1374    result := x;
     1375end;
     1376
     1377function TBGRAGradientScanner.ScanAtReflected(const p: TPointF): single;
     1378begin
     1379  with (FMatrix*p) do
     1380    result := abs(x);
     1381end;
     1382
     1383function TBGRAGradientScanner.ScanAtDiamond(const p: TPointF): single;
     1384begin
     1385  with (FMatrix*p) do
     1386    result := max(abs(x), abs(y));
     1387end;
     1388
     1389function TBGRAGradientScanner.ScanAtRadial(const p: TPointF): single;
     1390begin
     1391  with (FMatrix*p) do
     1392    result := sqrt(sqr(x) + sqr(y));
     1393end;
     1394
     1395function TBGRAGradientScanner.ScanAtRadial2(const p: TPointF): single;
     1396begin
     1397  with (FMatrix*p) do
     1398    result := (sqrt(sqr(x) + sqr(y))-FFocalRadius)/(FRadius-FFocalRadius);
     1399end;
     1400
     1401function TBGRAGradientScanner.ScanAtRadialFocal(const p: TPointF): single;
     1402begin
     1403  result := ComputeRadialFocal(FMatrix*p);
     1404end;
     1405
     1406function TBGRAGradientScanner.ScanAtAngular(const p: TPointF): single;
     1407begin
     1408  with (FMatrix*p) do
     1409  begin
     1410    if y >= 0 then
     1411      result := arctan2(y,x)/(2*Pi)
     1412    else
     1413      result := 1-arctan2(-y,x)/(2*Pi)
     1414  end;
     1415end;
     1416
     1417function TBGRAGradientScanner.ScanNextInline: TBGRAPixel;
     1418begin
     1419  if FIsAverage then
     1420    result := FAverageColor
     1421  else
     1422  begin
     1423    result := GetGradientColor(FScanNextFunc());
     1424    FPosition += PointF(FMatrix[1,1],FMatrix[2,1]);
     1425  end;
     1426end;
     1427
     1428function TBGRAGradientScanner.ScanNextExpandedInline: TExpandedPixel;
     1429begin
     1430  if FIsAverage then
     1431    result := FAverageExpandedColor
     1432  else
     1433  begin
     1434    result := GetGradientExpandedColor(FScanNextFunc());
     1435    FPosition += PointF(FMatrix[1,1],FMatrix[2,1]);
     1436  end;
     1437end;
     1438
     1439constructor TBGRAGradientScanner.Create(c1, c2: TBGRAPixel;
     1440  AGradientType: TGradientType; AOrigin, d1: TPointF; gammaColorCorrection: boolean;
     1441  Sinus: Boolean);
     1442begin
     1443  FGradient := nil;
     1444  SetGradient(c1,c2,gammaColorCorrection);
     1445  Init(AGradientType,AOrigin,d1,AffineMatrixIdentity,Sinus);
     1446end;
     1447
     1448constructor TBGRAGradientScanner.Create(c1, c2: TBGRAPixel;
     1449  AGradientType: TGradientType; AOrigin, d1, d2: TPointF; gammaColorCorrection: boolean;
     1450  Sinus: Boolean);
     1451begin
     1452  FGradient := nil;
     1453  if AGradientType in[gtLinear,gtReflected] then raise EInvalidArgument.Create('Two directions are not required for linear and reflected gradients');
     1454  SetGradient(c1,c2,gammaColorCorrection);
     1455  Init(AGradientType,AOrigin,d1,d2,AffineMatrixIdentity,Sinus);
    11131456end;
    11141457
    11151458constructor TBGRAGradientScanner.Create(gradient: TBGRACustomGradient;
    1116   gtype: TGradientType; o1, o2: TPointF; Sinus: Boolean; AGradientOwner: Boolean=False);
     1459  AGradientType: TGradientType; AOrigin, d1: TPointF; Sinus: Boolean; AGradientOwner: Boolean=False);
    11171460begin
    11181461  FGradient := gradient;
    11191462  FGradientOwner := AGradientOwner;
    1120   Init(gtype,o1,o2,Sinus);
     1463  Init(AGradientType,AOrigin,d1,AffineMatrixIdentity,Sinus);
     1464end;
     1465
     1466constructor TBGRAGradientScanner.Create(gradient: TBGRACustomGradient;
     1467  AGradientType: TGradientType; AOrigin, d1, d2: TPointF; Sinus: Boolean;
     1468  AGradientOwner: Boolean);
     1469begin
     1470  if AGradientType in[gtLinear,gtReflected] then raise EInvalidArgument.Create('Two directions are not required for linear and reflected gradients');
     1471  FGradient := gradient;
     1472  FGradientOwner := AGradientOwner;
     1473  Init(AGradientType,AOrigin,d1,d2,AffineMatrixIdentity,Sinus);
     1474end;
     1475
     1476constructor TBGRAGradientScanner.Create(gradient: TBGRACustomGradient;
     1477  AOrigin: TPointF; ARadius: single; AFocal: TPointF; AFocalRadius: single;
     1478  AGradientOwner: Boolean);
     1479begin
     1480  FGradient := gradient;
     1481  FGradientOwner := AGradientOwner;
     1482  Init(AOrigin, ARadius, AFocal, AFocalRadius, AffineMatrixIdentity, AffineMatrixIdentity);
    11211483end;
    11221484
    … …  
    11301492procedure TBGRAGradientScanner.ScanMoveTo(X, Y: Integer);
    11311493begin
    1132   InitScanInline(X,Y);
    1133   if FVertical then
     1494  FPosition := FMatrix*PointF(x,y);
     1495  if FRepeatHoriz then
    11341496  begin
    11351497    FHorizColor := ScanNextInline;
    … …  
    11401502function TBGRAGradientScanner.ScanNextPixel: TBGRAPixel;
    11411503begin
    1142   if FVertical then
     1504  if FRepeatHoriz then
    11431505    result := FHorizColor
    11441506  else
    … …  
    11481510function TBGRAGradientScanner.ScanNextExpandedPixel: TExpandedPixel;
    11491511begin
    1150   if FVertical then
     1512  if FRepeatHoriz then
    11511513    result := FHorizExpandedColor
    11521514  else
    … …  
    11551517
    11561518function TBGRAGradientScanner.ScanAt(X, Y: Single): TBGRAPixel;
    1157 var p: TPointF;
    1158     a,a2: single;
    1159     ai: integer;
    1160 begin
    1161   if len = 0 then
    1162   begin
    1163     result := mergedColor;
    1164     exit;
    1165   end;
    1166 
    1167   p.x := X - FOrigin1.x;
    1168   p.y := Y - FOrigin1.y;
    1169   case FGradientType of
    1170     gtLinear:    a := p.x * u.x + p.y * u.y;
    1171     gtReflected: a := abs(p.x * u.x + p.y * u.y);
    1172     gtDiamond:
    1173         begin
    1174           a   := abs(p.x * u.x + p.y * u.y);
    1175           a2  := abs(p.x * u.y - p.y * u.x);
    1176           if a2 > a then a := a2;
    1177         end;
    1178     gtRadial:    a := sqrt(sqr(p.x * u.x + p.y * u.y) + sqr(p.x * u.y - p.y * u.x));
    1179   end;
    1180 
    1181   if FSinus then
    1182   begin
    1183     a := a*aFactor;
    1184     if (a <= low(int64)) or (a >= high(int64)) then
    1185       result := mergedColor
    1186     else
    1187     begin
    1188       ai := Sin65536(round(a));
    1189       result := FGradient.GetColorAt(ai);
    1190     end;
    1191   end else
    1192     result := FGradient.GetColorAtF(a*aFactorF);
     1519begin
     1520  if FIsAverage then
     1521    result := FAverageColor
     1522  else
     1523    result := GetGradientColor(FScanAtFunc(PointF(X,Y)));
    11931524end;
    11941525
    11951526function TBGRAGradientScanner.ScanAtExpanded(X, Y: Single): TExpandedPixel;
    1196 var p: TPointF;
    1197     a,a2: single;
    1198     ai: integer;
    1199 begin
    1200   if len = 0 then
    1201   begin
    1202     result := mergedExpandedColor;
    1203     exit;
    1204   end;
    1205 
    1206   p.x := X - FOrigin1.x;
    1207   p.y := Y - FOrigin1.y;
    1208   case FGradientType of
    1209     gtLinear:    a := p.x * u.x + p.y * u.y;
    1210     gtReflected: a := abs(p.x * u.x + p.y * u.y);
    1211     gtDiamond:
    1212         begin
    1213           a   := abs(p.x * u.x + p.y * u.y);
    1214           a2  := abs(p.x * u.y - p.y * u.x);
    1215           if a2 > a then a := a2;
    1216         end;
    1217     gtRadial:    a := sqrt(sqr(p.x * u.x + p.y * u.y) + sqr(p.x * u.y - p.y * u.x));
    1218   end;
    1219 
    1220   if FSinus then
    1221   begin
    1222     a := a*aFactor;
    1223     if (a <= low(int64)) or (a >= high(int64)) then
    1224       result := mergedExpandedColor
    1225     else
    1226     begin
    1227       ai := Sin65536(round(a));
    1228       result := FGradient.GetExpandedColorAt(ai);
    1229     end;
    1230   end else
    1231     result := FGradient.GetExpandedColorAtF(a*aFactorF);
     1527begin
     1528  if FIsAverage then
     1529    result := FAverageExpandedColor
     1530  else
     1531    result := GetGradientExpandedColor(FScanAtFunc(PointF(X,Y)));
    12321532end;
    12331533
    … …  
    12361536var c: TBGRAPixel;
    12371537begin
    1238   if FVertical or (len = 0) then
    1239   begin
    1240     if FVertical then c := FHorizColor
    1241       else c := mergedColor;
     1538  if FRepeatHoriz then
     1539  begin
     1540    c := FHorizColor;
    12421541    case mode of
    12431542      dmDrawWithTransparency: DrawPixelsInline(pdest,c,count);
    … …  
    15731872  FScanAt := @FTexture.ScanAt;
    15741873  FGlobalOpacity:= AGlobalOpacity;
     1874  FOwnedScanner := nil;
     1875end;
     1876
     1877constructor TBGRAOpacityScanner.Create(ATexture: TBGRACustomScanner;
     1878  AGlobalOpacity: Byte; AOwned: boolean);
     1879begin
     1880  FTexture := ATexture;
     1881  FScanNext := @FTexture.ScanNextPixel;
     1882  FScanAt := @FTexture.ScanAt;
     1883  FGlobalOpacity:= AGlobalOpacity;
     1884  if AOwned then
     1885    FOwnedScanner := ATexture
     1886  else
     1887    FOwnedScanner := nil;
    15751888end;
    15761889
    … …  
    15781891begin
    15791892  fillchar(FTexture,sizeof(FTexture),0);
     1893  FOwnedScanner.Free;
    15801894  inherited Destroy;
    15811895end;
Note: See TracChangeset for help on using the changeset viewer.