Changeset 522


Ignore:
Timestamp:
Apr 17, 2019, 10:42:18 AM (5 years ago)
Author:
chronos
Message:
  • Modified: Updated Graphics32 library.
Location:
GraphicTest
Files:
106 added
17 deleted
50 edited

Legend:

Unmodified
Added
Removed
  • GraphicTest/GraphicTest.lpi

    r521 r522  
    66      <SessionStorage Value="InProjectDir"/>
    77      <MainUnit Value="0"/>
     8      <Scaled Value="True"/>
    89      <UseXPManifest Value="True"/>
     10      <XPManifest>
     11        <DpiAware Value="True"/>
     12      </XPManifest>
    913      <Icon Value="0"/>
    1014    </General>
     
    5256              <IgnoredMessages idx5024="True"/>
    5357            </CompilerMessages>
     58            <CustomOptions Value="-dopengl
     59-dGRAPHICS32"/>
    5460          </Other>
    5561        </CompilerOptions>
     
    7177    <RequiredPackages Count="5">
    7278      <Item1>
    73         <PackageName Value="lazopenglcontext"/>
     79        <PackageName Value="GR32_Lazarus"/>
     80        <DefaultFilename Value="Packages/Graphics32/Packages/GR32_Lazarus.lpk" Prefer="True"/>
    7481      </Item1>
    7582      <Item2>
     83        <PackageName Value="lazopenglcontext"/>
     84      </Item2>
     85      <Item3>
    7686        <PackageName Value="BGRABitmapPack"/>
    7787        <DefaultFilename Value="Packages/bgrabitmap/bgrabitmappack.lpk" Prefer="True"/>
    78       </Item2>
    79       <Item3>
    80         <PackageName Value="GR32_L"/>
    81         <DefaultFilename Value="Packages/Graphics32/Packages/GR32_L.lpk" Prefer="True"/>
    8288      </Item3>
    8389      <Item4>
     
    8894      </Item5>
    8995    </RequiredPackages>
    90     <Units Count="18">
     96    <Units Count="19">
    9197      <Unit0>
    9298        <Filename Value="GraphicTest.lpr"/>
     
    167173        <IsPartOfProject Value="True"/>
    168174      </Unit17>
     175      <Unit18>
     176        <Filename Value="Packages/Graphics32/Packages/GR32_Lazarus.lpk"/>
     177        <IsPartOfProject Value="True"/>
     178      </Unit18>
    169179    </Units>
    170180  </ProjectOptions>
     
    212222        <IgnoredMessages idx5024="True"/>
    213223      </CompilerMessages>
    214       <CustomOptions Value="-dopengl"/>
     224      <CustomOptions Value="-dOPENGL -dGRAPHICS32"/>
    215225    </Other>
    216226  </CompilerOptions>
  • GraphicTest/GraphicTest.lpr

    r521 r522  
    1010  Forms, SysUtils, openglcontext, UMainForm, UPlatform, UDrawMethod, UFastBitmap,
    1111  UDrawForm, bgrabitmappack,
    12   {$IFDEF GRAPHICS32}GR32_L,{$ENDIF}
    1312  UCanvasPixels, UCanvasPixelsUpdateLock,
    1413  ULazIntfImageColorsCopy, ULazIntfImageColorsNoCopy, UBGRABitmapPaintBox,
     
    3130
    3231  RequireDerivedFormResource := True;
     32  Application.Scaled:=True;
    3333  Application.Initialize;
    3434  Application.CreateForm(TMainForm, MainForm);
  • GraphicTest/Packages/Graphics32

    • Property svn:ignore set to
      lib
  • GraphicTest/Packages/Graphics32/GR32.inc

    r450 r522  
    174174  ----------------
    175175
    176      If defined SSE2 optimizations are not used (omitted)
    177 
    178    For faster pixel/color processing, SSE2 can be used which results in a huge
    179    performance boost over PUREPASCAL code or native assembler code.
     176    If defined SSE2 optimizations are not used (omitted)
     177
     178  For faster pixel/color processing, SSE2 can be used which results in a huge
     179  performance boost over PUREPASCAL code or native assembler code.
    180180
    181181*)
    182182
    183183  {-$DEFINE OMIT_SSE2}
     184
     185
     186(*
     187  Symbol: USEGR32GAMMA
     188  --------------------
     189
     190    If defined the polygon rasterizer will use the GR32 gamma correction LUT.
     191
     192  Disable for a slight performance increase.
     193*)
     194
     195{$DEFINE USEGR32GAMMA}
     196
     197
     198
     199(*
     200  Symbol: CHANGENOTIFICATIONS
     201  ---------------------------
     202
     203    If defined the polygon rasterizer will trigger change notifications.
     204
     205  Undefining this will avoid bounding box computations, which may
     206  improve performance slightly.
     207*)
     208
     209{$DEFINE CHANGENOTIFICATIONS}
     210
     211
     212
     213(*
     214  Symbol: USESTACKALLOC
     215  ---------------------
     216
     217    If defined stack allocation routines will be used in some functions.
     218
     219  Allocating memory on the stack is usually more efficient than using the
     220  memory manager. If a routine uses StackAllock/StackFree then it should
     221  always be wrapped inside a {$W+}...{$W-} block in order to generate
     222  a stack frame.
     223
     224  NOTE: Undefine this symbol if you get stack overflow errors.
     225*)
     226
     227{-$DEFINE USESTACKALLOC}
     228
     229(*
     230  Symbol: RGBA_FORMAT
     231  -------------------
     232
     233     Assume RGBA pixel format instead of BGRA (used by e.g. OpenGL.)
     234*)
     235
     236{-$DEFINE RGBA_FORMAT}
     237
     238(*
     239  Symbol: NOHINTING
     240  -----------------
     241
     242    Disables font hinting by default when using TextToPath() method.
     243
     244  It is usually preferrable to disable hinting when using a high quality
     245  polygon renderer like VPR. However, hinting can sometimes improve
     246  visual quality when rendering small text (text is adjusted to pixel
     247  boundaries which makes it more crisp.)
     248*)
     249
     250{$DEFINE NOHINTING}
     251
     252
     253(*
     254  Symbol: NOHORIZONTALHINTING
     255  ---------------------------
     256
     257    Disables horizontal font hinting when using TextToPath() method.
     258
     259  The following should not be used in conjunction with NOHINTING.
     260  It will attempt to address the problem of extreme font hinting in the
     261  GDI by disabling horizontal, but keeping vertical hinting.
     262*)
     263
     264{-$DEFINE NOHORIZONTALHINTING}
     265
     266
     267(*
     268  Symbol: USEKERNING
     269  -----------------
     270
     271    Enables font kerning when using TextToPath() method.
     272
     273  Kerning is the process of adjusting the spacing between characters in a
     274  proportional font, usually to achieve a visually pleasing result. However,
     275  parsing for kerning pairs is quite expensive in terms of CPU usage while the
     276  effect is often very little. Thus kerning is not enabled by default.
     277*)
     278
     279{-$DEFINE USEKERNING}
     280
     281
     282{-$DEFINE TEST_BLENDMEMRGB128SSE4}
  • GraphicTest/Packages/Graphics32/GR32.pas

    r450 r522  
    4444
    4545uses
    46   {$IFDEF FPC} LCLIntf, LCLType, Types, Controls, Graphics,{$ELSE}
    47   Windows, Messages, Controls, Graphics,{$ENDIF}
    48   Classes, SysUtils, GR32_System;
    49  
     46  {$IFDEF FPC} LCLIntf, LCLType, Types, {$ELSE}
     47  {$IFDEF COMPILERXE2_UP}UITypes, Types, {$ENDIF} Windows, {$ENDIF}
     48  Controls, Graphics, Classes, SysUtils;
     49
    5050{ Version Control }
    5151
    5252const
    53   Graphics32Version = '1.9.1';
     53  Graphics32Version = '2.0.0 alpha';
    5454
    5555{ 32-bit Color }
     
    6363  TArrayOfColor32 = array of TColor32;
    6464
     65{$IFNDEF RGBA_FORMAT}
    6566  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
     67{$ELSE}
     68  TColor32Component = (ccRed, ccGreen, ccBlue, ccAlpha);
     69{$ENDIF}
    6670  TColor32Components = set of TColor32Component;
    6771
     
    6973  TColor32Entry = packed record
    7074    case Integer of
     75{$IFNDEF RGBA_FORMAT}
    7176      0: (B, G, R, A: Byte);
     77{$ELSE}
     78      0: (R, G, B, A: Byte);
     79{$ENDIF}
    7280      1: (ARGB: TColor32);
    7381      2: (Planes: array[0..3] of Byte);
     
    236244  // Some semi-transparent color constants
    237245  clTrWhite32             = TColor32($7FFFFFFF);
     246  clTrGray32              = TColor32($7F7F7F7F);
    238247  clTrBlack32             = TColor32($7F000000);
    239248  clTrRed32               = TColor32($7FFF0000);
     
    258267function AlphaComponent(Color32: TColor32): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
    259268function Intensity(Color32: TColor32): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
     269function InvertColor(Color32: TColor32): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
    260270function SetAlpha(Color32: TColor32; NewAlpha: Integer): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
     271procedure ModifyAlpha(var Color32: TColor32; NewAlpha: Byte); {$IFDEF USEINLINING} inline; {$ENDIF}
     272procedure ScaleAlpha(var Color32: TColor32; Scale: Single); {$IFDEF USEINLINING} inline; {$ENDIF}
    261273
    262274// Color space conversion
    263275function HSLtoRGB(H, S, L: Single): TColor32; overload;
    264276procedure RGBtoHSL(RGB: TColor32; out H, S, L : Single); overload;
    265 function HSLtoRGB(H, S, L: Integer): TColor32; overload;
     277function HSLtoRGB(H, S, L: Integer; A: Integer = $ff): TColor32; overload;
    266278procedure RGBtoHSL(RGB: TColor32; out H, S, L: Byte); overload;
     279function HSVtoRGB(H, S, V: Single): TColor32;
     280procedure RGBToHSV(Color: TColor32; out H, S, V: Single);
    267281
    268282{$IFNDEF PLATFORM_INDEPENDENT}
     
    277291  PFixed = ^TFixed;
    278292  TFixed = type Integer;
    279 
     293  {$NODEFINE TFixed}
     294
     295  {$NODEFINE PFixedRec}
    280296  PFixedRec = ^TFixedRec;
     297  {$NODEFINE TFixedRec}
    281298  TFixedRec = packed record
    282299    case Integer of
     
    315332  TArrayOfArrayOfInteger = array of TArrayOfInteger;
    316333
     334  PCardinalArray = ^TCardinalArray;
     335  TCardinalArray = array [0..0] of Cardinal;
     336  PArrayOfCardinal = ^TArrayOfCardinal;
     337  TArrayOfCardinal = array of Cardinal;
     338  PArrayOfArrayOfCardinal = ^TArrayOfArrayOfCardinal;
     339  TArrayOfArrayOfCardinal = array of TArrayOfCardinal;
     340
    317341  PSingleArray = ^TSingleArray;
    318342  TSingleArray = array [0..0] of Single;
     
    330354  FixedHalf = $7FFF;
    331355  FixedPI  = Round(PI * FixedOne);
    332   FixedToFloat = 1/FixedOne;
     356  FixedToFloat = 1 / FixedOne;
     357
     358  COne255th = 1 / $FF;
    333359
    334360function Fixed(S: Single): TFixed; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
     
    355381  TFloatPoint = record
    356382    X, Y: TFloat;
     383  {$IFDEF SUPPORT_ENHANCED_RECORDS}
     384  public
     385    {$IFNDEF FPC}
     386    {$IFDEF COMPILERXE2_UP}
     387    constructor Create(P: TPointF); overload;
     388    {$ENDIF}
     389    constructor Create(P: TPoint); overload;
     390    constructor Create(X, Y: Integer); overload;
     391    constructor Create(X, Y: Single); overload;
     392    {$ENDIF}
     393
     394    // operator overloads
     395    class operator Equal(const Lhs, Rhs: TFloatPoint): Boolean;
     396    class operator NotEqual(const Lhs, Rhs: TFloatPoint): Boolean;
     397    class operator Add(const Lhs, Rhs: TFloatPoint): TFloatPoint;
     398    class operator Subtract(const Lhs, Rhs: TFloatPoint): TFloatPoint;
     399    {$IFDEF COMPILERXE2_UP}
     400    class operator Explicit(A: TPointF): TFloatPoint;
     401    class operator Implicit(A: TPointF): TFloatPoint;
     402    {$ENDIF}
     403
     404    class function Zero: TFloatPoint; inline; static;
     405  {$ENDIF}
    357406  end;
    358407
     
    367416  TFixedPoint = record
    368417    X, Y: TFixed;
    369   end;
     418  {$IFDEF SUPPORT_ENHANCED_RECORDS}
     419  public
     420    {$IFNDEF FPC}
     421    {$IFDEF COMPILERXE2_UP}
     422    constructor Create(P: TPointF); overload;
     423    {$ENDIF}
     424    constructor Create(P: TFloatPoint); overload;
     425    constructor Create(X, Y: TFixed); overload;
     426    constructor Create(X, Y: Integer); overload;
     427    constructor Create(X, Y: TFloat); overload;
     428    {$ENDIF}
     429
     430    // operator overloads
     431    class operator Equal(const Lhs, Rhs: TFixedPoint): Boolean;
     432    class operator NotEqual(const Lhs, Rhs: TFixedPoint): Boolean;
     433    class operator Add(const Lhs, Rhs: TFixedPoint): TFixedPoint;
     434    class operator Subtract(const Lhs, Rhs: TFixedPoint): TFixedPoint;
     435
     436    class function Zero: TFixedPoint; inline; static;
     437  {$ENDIF}
     438  end;
     439  {$NODEFINE TFixedPoint}
    370440
    371441  PFixedPointArray = ^TFixedPointArray;
     
    397467
    398468  PFloatRect = ^TFloatRect;
     469  {$NODEFINE TFloatRect}
     470{$IFDEF SupportsBoost}
     471  (*$HPPEMIT '#include <boost/strong_typedef.hpp>'*)
     472{$ENDIF}
     473  (*$HPPEMIT 'namespace Gr32 {'*)
     474{$IFDEF SupportsBoost}
     475  (*$HPPEMIT 'BOOST_STRONG_TYPEDEF(int, TFixed)'*)
     476{$ELSE}
     477  (*$HPPEMIT 'typedef int TFixed;'*)
     478{$ENDIF}
     479  (*$HPPEMIT 'struct TFixedPoint { float X, Y; }; typedef struct TFixedPoint TFixedPoint;'*)
     480  (*$HPPEMIT 'struct TFloatRect { float Left, Top, Right, Bottom; }; typedef struct TFloatRect TFloatRect;'*)
     481  (*$HPPEMIT 'struct TFixedRect { TFixed Left, Top, Right, Bottom; }; typedef struct TFixedRect TFixedRect;'*)
     482  (*$HPPEMIT '} // namespace Gr32 '*)
    399483  TFloatRect = packed record
    400484    case Integer of
     
    403487  end;
    404488
     489  {$NODEFINE PFixedRect}
    405490  PFixedRect = ^TFixedRect;
     491  {$NODEFINE TFixedRect}
    406492  TFixedRect = packed record
    407493    case Integer of
     
    417503function MakeRect(const FXR: TFixedRect; Rounding: TRectRounding = rrClosest): TRect; overload;
    418504function FixedRect(const L, T, R, B: TFixed): TFixedRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
     505function FixedRect(const TopLeft, BottomRight: TFixedPoint): TFixedRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
    419506function FixedRect(const ARect: TRect): TFixedRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
    420507function FixedRect(const FR: TFloatRect): TFixedRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
    421508function FloatRect(const L, T, R, B: TFloat): TFloatRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
     509function FloatRect(const TopLeft, BottomRight: TFloatPoint): TFloatRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
    422510function FloatRect(const ARect: TRect): TFloatRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
    423511function FloatRect(const FXR: TFixedRect): TFloatRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
     
    458546{$ENDIF}
    459547
    460 { Gamma bias for line/pixel antialiasing }
    461 
    462 var
    463   GAMMA_TABLE: array [Byte] of Byte;
    464 
    465 procedure SetGamma(Gamma: Single = 0.7);
    466 
    467548type
    468549  { TPlainInterfacedPersistent }
     
    475556  protected
    476557    { IInterface }
    477     function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    478     function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    479     function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    480 
     558{$IFDEF FPC_HAS_CONSTREF}
     559    function QueryInterface(constref iid: TGuid; out obj): HResult; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
     560    function _AddRef: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
     561    function _Release: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
     562{$ELSE}
     563    function QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
     564    function _AddRef: LongInt; stdcall;
     565    function _Release: LongInt; stdcall;
     566{$ENDIF}
    481567    property RefCounted: Boolean read FRefCounted write FRefCounted;
    482568  public
     
    535621    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); virtual;
    536622  public
     623    constructor Create(Width, Height: Integer); reintroduce; overload;
     624
    537625    procedure Delete; virtual;
    538626    function  Empty: Boolean; virtual;
     
    540628    function SetSizeFrom(Source: TPersistent): Boolean;
    541629    function SetSize(NewWidth, NewHeight: Integer): Boolean; virtual;
     630
    542631    property Height: Integer read FHeight write SetHeight;
    543632    property Width: Integer read FWidth write SetWidth;
     
    602691
    603692{$IFDEF BITS_GETTER}
    604     function GetBits: PColor32Array;     {$IFDEF USEINLINING} inline; {$ENDIF}
     693    function GetBits: PColor32Array; {$IFDEF USEINLINING} inline; {$ENDIF}
    605694{$ENDIF}
    606695
     
    618707    procedure SetResampler(Resampler: TCustomResampler);
    619708    function GetResamplerClassName: string;
    620     procedure SetResamplerClassName(Value: string);
     709    procedure SetResamplerClassName(const Value: string);
     710    function GetPenPos: TPoint;
     711    procedure SetPenPos(const Value: TPoint);
     712    function GetPenPosF: TFixedPoint;
     713    procedure SetPenPosF(const Value: TFixedPoint);
    621714  protected
    622715    WrapProcHorz: TWrapProcEx;
     
    638731    procedure DefineProperties(Filer: TFiler); override;
    639732
    640     procedure InitializeBackend; virtual;
     733    procedure InitializeBackend(Backend: TCustomBackendClass); virtual;
    641734    procedure FinalizeBackend; virtual;
    642735    procedure SetBackend(const Backend: TCustomBackend); virtual;
    643736
    644     function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; override;
     737{$IFDEF FPC_HAS_CONSTREF}
     738    function QueryInterface(constref iid: TGuid; out obj): HResult; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
     739{$ELSE}
     740    function QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
     741{$ENDIF}
    645742
    646743    function  GetPixel(X, Y: Integer): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
     
    673770    procedure SetPixelXW(X, Y: TFixed; Value: TColor32);
    674771  public
    675     constructor Create; override;
     772    constructor Create(Backend: TCustomBackendClass); reintroduce; overload; virtual;
     773    constructor Create; reintroduce; overload; virtual;
     774    constructor Create(Width, Height: Integer); reintroduce; overload; virtual;
    676775    destructor Destroy; override;
     776
     777    class function GetPlatformBackendClass: TCustomBackendClass; virtual;
    677778
    678779    procedure Assign(Source: TPersistent); override;
     
    713814
    714815    procedure DrawTo(Dst: TCustomBitmap32); overload;
     816    procedure DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer); overload;
    715817    procedure DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer; const SrcRect: TRect); overload;
    716     procedure DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer); overload;
    717818    procedure DrawTo(Dst: TCustomBitmap32; const DstRect: TRect); overload;
    718819    procedure DrawTo(Dst: TCustomBitmap32; const DstRect, SrcRect: TRect); overload;
     
    765866    procedure LineToXSP(X, Y: TFixed);
    766867    procedure LineToFSP(X, Y: Single);
     868    property PenPos: TPoint read GetPenPos write SetPenPos;
     869    property PenPosF: TFixedPoint read GetPenPosF write SetPenPosF;
    767870
    768871    procedure FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32);
     
    840943  private
    841944    FOnHandleChanged: TNotifyEvent;
    842      
     945
    843946    procedure BackendChangedHandler(Sender: TObject); override;
    844947    procedure BackendChangingHandler(Sender: TObject); override;
     
    855958    procedure SetFont(Value: TFont);
    856959  protected
    857     procedure InitializeBackend; override;
    858960    procedure FinalizeBackend; override;
    859961    procedure SetBackend(const Backend: TCustomBackend); override;
    860    
     962
    861963    procedure HandleChanged; virtual;
    862964    procedure CopyPropertiesTo(Dst: TCustomBitmap32); override;
    863965  public
     966    class function GetPlatformBackendClass: TCustomBackendClass; override;
     967
    864968  {$IFDEF BCB}
    865969    procedure Draw(const DstRect, SrcRect: TRect; hSrc: Cardinal); overload;
     
    871975    procedure DrawTo(hDst: Cardinal; DstX, DstY: Integer); overload;
    872976    procedure DrawTo(hDst: Cardinal; const DstRect, SrcRect: TRect); overload;
    873     procedure TileTo(hDst: Cardinal; const DstRect, SrcRect: TRect);
     977    procedure TileTo(hDst: Cardinal; const DstRect, SrcRect: TRect); overload;
    874978{$ELSE}
    875     procedure DrawTo(hDst: HDC; DstX, DstY: Integer); overload;
     979    procedure DrawTo(hDst: HDC; DstX: Integer = 0; DstY: Integer = 0); overload;
    876980    procedure DrawTo(hDst: HDC; const DstRect, SrcRect: TRect); overload;
    877     procedure TileTo(hDst: HDC; const DstRect, SrcRect: TRect);
     981    procedure TileTo(hDst: HDC; const DstRect, SrcRect: TRect); overload;
    878982{$ENDIF}
    879983
     984{$IFDEF COMPILER2009_UP}
     985    procedure DrawTo(Dst: TControlCanvas; DstX: Integer = 0; DstY: Integer = 0); overload;
     986    procedure DrawTo(Dst: TControlCanvas; const DstRect, SrcRect: TRect); overload;
     987    procedure TileTo(Dst: TControlCanvas; const DstRect, SrcRect: TRect); overload;
     988{$ENDIF}
     989
    880990    procedure UpdateFont;
    881     procedure Textout(X, Y: Integer; const Text: String); overload;
    882     procedure Textout(X, Y: Integer; const ClipRect: TRect; const Text: String); overload;
    883     procedure Textout(DstRect: TRect; const Flags: Cardinal; const Text: String); overload;
    884     function  TextExtent(const Text: String): TSize;
    885     function  TextHeight(const Text: String): Integer;
    886     function  TextWidth(const Text: String): Integer;
    887     procedure RenderText(X, Y: Integer; const Text: String; AALevel: Integer; Color: TColor32);
     991    procedure Textout(X, Y: Integer; const Text: string); overload;
     992    procedure Textout(X, Y: Integer; const ClipRect: TRect; const Text: string); overload;
     993    procedure Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string); overload;
     994    function  TextExtent(const Text: string): TSize;
     995    function  TextHeight(const Text: string): Integer;
     996    function  TextWidth(const Text: string): Integer;
     997    procedure RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32);
    888998    procedure TextoutW(X, Y: Integer; const Text: Widestring); overload;
    889999    procedure TextoutW(X, Y: Integer; const ClipRect: TRect; const Text: Widestring); overload;
    890     procedure TextoutW(DstRect: TRect; const Flags: Cardinal; const Text: Widestring); overload;
     1000    procedure TextoutW(var DstRect: TRect; const Flags: Cardinal; const Text: Widestring); overload;
    8911001    function  TextExtentW(const Text: Widestring): TSize;
    8921002    function  TextHeightW(const Text: Widestring): Integer;
     
    9361046    function Empty: Boolean; virtual;
    9371047
    938     procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer; ClearBuffer: Boolean = True); virtual;
     1048    procedure ChangeSize(out Width, Height: Integer; NewWidth, NewHeight: Integer; ClearBuffer: Boolean = True); virtual;
    9391049
    9401050{$IFDEF BITS_GETTER}
     
    9921102  TCustomResamplerClass = class of TCustomResampler;
    9931103
    994 function GetPlatformBackendClass: TCustomBackendClass;
    995 
    9961104var
    9971105  StockBitmap: TBitmap;
    9981106
     1107resourcestring
     1108  RCStrUnmatchedReferenceCounting = 'Unmatched reference counting.';
     1109  RCStrCannotSetSize = 'Can''t set size from ''%s''';
     1110  RCStrInpropriateBackend = 'Inappropriate Backend';
     1111
    9991112implementation
    10001113
    10011114uses
    1002   Math, GR32_Blend, GR32_Filters, GR32_LowLevel, GR32_Math,
    1003   GR32_Resamplers, GR32_Containers, GR32_Backends, GR32_Backends_Generic,
     1115  Math, GR32_Blend, GR32_LowLevel, GR32_Math, GR32_Resamplers,
     1116  GR32_Containers, GR32_Gamma, GR32_Backends, GR32_Backends_Generic,
    10041117{$IFDEF FPC}
    10051118  Clipbrd,
     
    10191132  Clipbrd, GR32_Backends_VCL,
    10201133{$ENDIF}
    1021   GR32_DrawingEx;
     1134  GR32_VectorUtils;
    10221135
    10231136type
     
    10451158const
    10461159  ZERO_RECT: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
    1047 
    1048 resourcestring
    1049   RCStrUnmatchedReferenceCounting = 'Unmatched reference counting.';
    1050   RCStrCannotSetSize = 'Can''t set size from ''%s''';
    1051   RCStrInpropriateBackend = 'Inpropriate Backend';
    10521160
    10531161{ Color construction and conversion functions }
     
    11281236{$ENDIF}
    11291237        // the alpha channel byte is set to zero!
    1130         ROL     EAX, 8  // ABGR  ->  BGRA
     1238        ROL     EAX, 8  // ABGR  ->  RGBA
    11311239        XOR     AL, AL  // BGRA  ->  BGR0
    11321240        BSWAP   EAX     // BGR0  ->  0RGB
     
    11991307end;
    12001308
     1309function InvertColor(Color32: TColor32): TColor32;
     1310begin
     1311  TColor32Entry(Result).R := $FF - TColor32Entry(Color32).R;
     1312  TColor32Entry(Result).G := $FF - TColor32Entry(Color32).G;
     1313  TColor32Entry(Result).B := $FF - TColor32Entry(Color32).B;
     1314  TColor32Entry(Result).A := TColor32Entry(Color32).A;
     1315end;
     1316
    12011317function SetAlpha(Color32: TColor32; NewAlpha: Integer): TColor32;
    12021318begin
    1203   if NewAlpha < 0 then NewAlpha := 0
    1204   else if NewAlpha > 255 then NewAlpha := 255;
     1319  if NewAlpha < 0 then
     1320    NewAlpha := 0
     1321  else if NewAlpha > $FF then
     1322    NewAlpha := $FF;
    12051323  Result := (Color32 and $00FFFFFF) or (TColor32(NewAlpha) shl 24);
     1324end;
     1325
     1326procedure ModifyAlpha(var Color32: TColor32; NewAlpha: Byte);
     1327begin
     1328  TColor32Entry(Color32).A := NewAlpha;
     1329end;
     1330
     1331procedure ScaleAlpha(var Color32: TColor32; Scale: Single);
     1332begin
     1333  TColor32Entry(Color32).A := Round(Scale * TColor32Entry(Color32).A);
    12061334end;
    12071335
     
    12131341var
    12141342  M1, M2: Single;
    1215   R, G, B: Byte;
    12161343
    12171344  function HueToColor(Hue: Single): Byte;
     
    12201347  begin
    12211348    Hue := Hue - Floor(Hue);
    1222     if 6 * Hue < 1 then V := M1 + (M2 - M1) * Hue * 6
    1223     else if 2 * Hue < 1 then V := M2
    1224     else if 3 * Hue < 2 then V := M1 + (M2 - M1) * (2 * OneOverThree - Hue) * 6
     1349    if 6 * Hue < 1 then
     1350      V := M1 + (M2 - M1) * Hue * 6
     1351    else if 2 * Hue < 1 then
     1352      V := M2
     1353    else if 3 * Hue < 2 then
     1354      V := M1 + (M2 - M1) * (2 * OneOverThree - Hue) * 6
    12251355    else V := M1;
    1226     Result := Round(255 * V);
     1356    Result := Round($FF * V);
    12271357  end;
    12281358
     
    12301360  if S = 0 then
    12311361  begin
    1232     R := Round(255 * L);
    1233     G := R;
    1234     B := R;
    1235   end
     1362    Result := Gray32(Round($FF * L));
     1363    Exit;
     1364  end;
     1365
     1366  if L <= 0.5 then
     1367    M2 := L * (1 + S)
    12361368  else
    1237   begin
    1238     if L <= 0.5 then M2 := L * (1 + S)
    1239     else M2 := L + S - L * S;
    1240     M1 := 2 * L - M2;
    1241     R := HueToColor(H + OneOverThree);
    1242     G := HueToColor(H);
    1243     B := HueToColor(H - OneOverThree)
    1244   end;
    1245   Result := Color32(R, G, B);
     1369    M2 := L + S - L * S;
     1370  M1 := 2 * L - M2;
     1371  Result := Color32(
     1372    HueToColor(H + OneOverThree),
     1373    HueToColor(H),
     1374    HueToColor(H - OneOverThree));
    12461375end;
    12471376
     
    12491378const
    12501379  // reciprocal mul. opt.
    1251   R255 = 1 / 255;
    12521380  R6 = 1 / 6;
    12531381
     
    12551383  R, G, B, D, Cmax, Cmin: Single;
    12561384begin
    1257   R := RedComponent(RGB) * R255;
    1258   G := GreenComponent(RGB) * R255;
    1259   B := BlueComponent(RGB) * R255;
     1385  R := RedComponent(RGB) * COne255th;
     1386  G := GreenComponent(RGB) * COne255th;
     1387  B := BlueComponent(RGB) * COne255th;
    12601388  Cmax := Max(R, Max(G, B));
    12611389  Cmin := Min(R, Min(G, B));
     
    12881416end;
    12891417
    1290 function HSLtoRGB(H, S, L: Integer): TColor32;
     1418function HSLtoRGB(H, S, L, A: Integer): TColor32;
    12911419var
    12921420  V, M, M1, M2, VSF: Integer;
     
    13061434    M2 := V - VSF;
    13071435    case H shr 8 of
    1308       0: Result := Color32(V, M1, M);
    1309       1: Result := Color32(M2, V, M);
    1310       2: Result := Color32(M, V, M1);
    1311       3: Result := Color32(M, M2, V);
    1312       4: Result := Color32(M1, M, V);
    1313       5: Result := Color32(V, M, M2);
     1436      0: Result := Color32(V, M1, M, A);
     1437      1: Result := Color32(M2, V, M, A);
     1438      2: Result := Color32(M, V, M1, A);
     1439      3: Result := Color32(M, M2, V, A);
     1440      4: Result := Color32(M1, M, V, A);
     1441      5: Result := Color32(V, M, M2, A);
    13141442    else
    13151443      Result := 0;
     
    13371465  else
    13381466  begin
    1339     D := (Cmax - Cmin) * 255;
     1467    D := (Cmax - Cmin) * $FF;
    13401468    if L <= $7F then
    13411469      S := D div (Cmax + Cmin)
    13421470    else
    1343       S := D div (255 * 2 - Cmax - Cmin);
     1471      S := D div ($FF * 2 - Cmax - Cmin);
    13441472
    13451473    D := D * 6;
    13461474    if R = Cmax then
    1347       HL := (G - B) * 255 * 255 div D
     1475      HL := (G - B) * $FF * $FF div D
    13481476    else if G = Cmax then
    1349       HL := 255 * 2 div 6 + (B - R) * 255 * 255 div D
     1477      HL := $FF * 2 div 6 + (B - R) * $FF * $FF div D
    13501478    else
    1351       HL := 255 * 4 div 6 + (R - G) * 255 * 255 div D;
    1352 
    1353     if HL < 0 then HL := HL + 255 * 2;
     1479      HL := $FF * 4 div 6 + (R - G) * $FF * $FF div D;
     1480
     1481    if HL < 0 then HL := HL + $FF * 2;
    13541482    H := HL;
     1483  end;
     1484end;
     1485
     1486function HSVtoRGB(H, S, V: Single): TColor32;
     1487var
     1488  Tmp: TFloat;
     1489  Sel, Q, P: Integer;
     1490begin
     1491  V := 255 * V;
     1492  if S = 0 then
     1493  begin
     1494    Result := Gray32(Trunc(V));
     1495    Exit;
     1496  end; 
     1497
     1498  H := H - Floor(H);
     1499  Tmp := 6 * H - Floor(6 * H);
     1500
     1501  Sel := Trunc(6 * H);
     1502  if (Sel mod 2) = 0 then
     1503    Tmp := 1 - Tmp;
     1504
     1505  Q := Trunc(V * (1 - S));
     1506  P := Trunc(V * (1 - S * Tmp));
     1507
     1508  case Sel of
     1509    0:
     1510      Result := Color32(Trunc(V), P, Q);
     1511    1:
     1512      Result := Color32(P, Trunc(V), Q);
     1513    2:
     1514      Result := Color32(Q, Trunc(V), P);
     1515    3:
     1516      Result := Color32(Q, P, Trunc(V));
     1517    4:
     1518      Result := Color32(P, Q, Trunc(V));
     1519    5:
     1520      Result := Color32(Trunc(V), Q, P);
     1521  else
     1522    Result := Gray32(0);
     1523  end;
     1524end;
     1525
     1526procedure RGBToHSV(Color: TColor32; out H, S, V: Single);
     1527var
     1528  Delta, Min, Max: Single;
     1529  R, G, B: Integer;
     1530const
     1531  COneSixth = 1 / 6;
     1532begin
     1533  R := RedComponent(Color);
     1534  G := GreenComponent(Color);
     1535  B := BlueComponent(Color);
     1536
     1537  Min := MinIntValue([R, G, B]);
     1538  Max := MaxIntValue([R, G, B]);
     1539  V := Max / 255;
     1540
     1541  Delta := Max - Min;
     1542  if Max = 0 then
     1543    S := 0
     1544  else
     1545    S := Delta / Max;
     1546
     1547  if S = 0.0 then
     1548    H := 0
     1549  else
     1550  begin
     1551    if R = Max then
     1552      H := COneSixth * (G - B) / Delta
     1553    else if G = Max then
     1554      H := COneSixth * (2 + (B - R) / Delta)
     1555    else if B = Max then
     1556      H := COneSixth * (4 + (R - G) / Delta);
     1557
     1558    if H < 0.0 then
     1559      H := H + 1;
    13551560  end;
    13561561end;
     
    13671572  L.palVersion := $300;
    13681573  L.palNumEntries := 256;
    1369   for I := 0 to 255 do
     1574  for I := 0 to $FF do
    13701575  begin
    13711576    Cl := P[I];
     
    13861591function Fixed(S: Single): TFixed;
    13871592begin
    1388   Result := Round(S * 65536);
     1593  Result := Round(S * FixedOne);
    13891594end;
    13901595
     
    14281633
    14291634function FloatPoint(const FXP: TFixedPoint): TFloatPoint;
    1430 const
    1431   F = 1 / 65536;
    14321635begin
    14331636  with FXP do
    14341637  begin
    1435     Result.X := X * F;
    1436     Result.Y := Y * F;
    1437   end;
    1438 end;
     1638    Result.X := X * FixedToFloat;
     1639    Result.Y := Y * FixedToFloat;
     1640  end;
     1641end;
     1642
     1643{$IFDEF SUPPORT_ENHANCED_RECORDS}
     1644{$IFNDEF FPC}
     1645constructor TFloatPoint.Create(P: TPoint);
     1646begin
     1647  Self.X := P.X;
     1648  Self.Y := P.Y;
     1649end;
     1650
     1651{$IFDEF COMPILERXE2_UP}
     1652constructor TFloatPoint.Create(P: TPointF);
     1653begin
     1654  Self.X := P.X;
     1655  Self.Y := P.Y;
     1656end;
     1657{$ENDIF}
     1658
     1659constructor TFloatPoint.Create(X, Y: Integer);
     1660begin
     1661  Self.X := X;
     1662  Self.Y := Y;
     1663end;
     1664
     1665constructor TFloatPoint.Create(X, Y: TFloat);
     1666begin
     1667  Self.X := X;
     1668  Self.Y := Y;
     1669end;
     1670{$ENDIF}
     1671
     1672// operator overloads
     1673class operator TFloatPoint.Equal(const Lhs, Rhs: TFloatPoint): Boolean;
     1674begin
     1675  Result := (Lhs.X = Rhs.X) and (Lhs.Y = Rhs.Y);
     1676end;
     1677
     1678class operator TFloatPoint.NotEqual(const Lhs, Rhs: TFloatPoint): Boolean;
     1679begin
     1680  Result := (Lhs.X <> Rhs.X) or (Lhs.Y <> Rhs.Y);
     1681end;
     1682
     1683class operator TFloatPoint.Add(const Lhs, Rhs: TFloatPoint): TFloatPoint;
     1684begin
     1685  Result.X := Lhs.X + Rhs.X;
     1686  Result.Y := Lhs.Y + Rhs.Y;
     1687end;
     1688
     1689class operator TFloatPoint.Subtract(const Lhs, Rhs: TFloatPoint): TFloatPoint;
     1690begin
     1691  Result.X := Lhs.X - Rhs.X;
     1692  Result.Y := Lhs.Y - Rhs.Y;
     1693end;
     1694
     1695{$IFDEF COMPILERXE2_UP}
     1696class operator TFloatPoint.Explicit(A: TPointF): TFloatPoint;
     1697begin
     1698  Result.X := A.X;
     1699  Result.Y := A.Y;
     1700end;
     1701
     1702class operator TFloatPoint.Implicit(A: TPointF): TFloatPoint;
     1703begin
     1704  Result.X := A.X;
     1705  Result.Y := A.Y;
     1706end;
     1707{$ENDIF}
     1708
     1709class function TFloatPoint.Zero: TFloatPoint;
     1710begin
     1711  Result.X := 0;
     1712  Result.Y := 0;
     1713end;
     1714
     1715{$IFNDEF FPC}
     1716{$IFDEF COMPILERXE2_UP}
     1717constructor TFixedPoint.Create(P: TPointF);
     1718begin
     1719  Self.X := Fixed(P.X);
     1720  Self.Y := Fixed(P.Y);
     1721end;
     1722{$ENDIF}
     1723
     1724constructor TFixedPoint.Create(P: TFloatPoint);
     1725begin
     1726  Self.X := Fixed(P.X);
     1727  Self.Y := Fixed(P.Y);
     1728end;
     1729
     1730constructor TFixedPoint.Create(X, Y: TFixed);
     1731begin
     1732  Self.X := X;
     1733  Self.Y := Y;
     1734end;
     1735
     1736constructor TFixedPoint.Create(X, Y: Integer);
     1737begin
     1738  Self.X := Fixed(X);
     1739  Self.Y := Fixed(Y);
     1740end;
     1741
     1742constructor TFixedPoint.Create(X, Y: TFloat);
     1743begin
     1744  Self.X := Fixed(X);
     1745  Self.Y := Fixed(Y);
     1746end;
     1747{$ENDIF}
     1748
     1749// operator overloads
     1750class operator TFixedPoint.Equal(const Lhs, Rhs: TFixedPoint): Boolean;
     1751begin
     1752  Result := (Lhs.X = Rhs.X) and (Lhs.Y = Rhs.Y);
     1753end;
     1754
     1755class operator TFixedPoint.NotEqual(const Lhs, Rhs: TFixedPoint): Boolean;
     1756begin
     1757  Result := (Lhs.X <> Rhs.X) or (Lhs.Y <> Rhs.Y);
     1758end;
     1759
     1760class operator TFixedPoint.Add(const Lhs, Rhs: TFixedPoint): TFixedPoint;
     1761begin
     1762  Result.X := Lhs.X + Rhs.X;
     1763  Result.Y := Lhs.Y + Rhs.Y;
     1764end;
     1765
     1766class operator TFixedPoint.Subtract(const Lhs, Rhs: TFixedPoint): TFixedPoint;
     1767begin
     1768  Result.X := Lhs.X - Rhs.X;
     1769  Result.Y := Lhs.Y - Rhs.Y;
     1770end;
     1771
     1772class function TFixedPoint.Zero: TFixedPoint;
     1773begin
     1774  Result.X := 0;
     1775  Result.Y := 0;
     1776end;
     1777{$ENDIF}
    14391778
    14401779function FixedPoint(X, Y: Integer): TFixedPoint; overload;
     
    14461785function FixedPoint(X, Y: Single): TFixedPoint; overload;
    14471786begin
    1448   Result.X := Round(X * 65536);
    1449   Result.Y := Round(Y * 65536);
     1787  Result.X := Round(X * FixedOne);
     1788  Result.Y := Round(Y * FixedOne);
    14501789end;
    14511790
     
    14581797function FixedPoint(const FP: TFloatPoint): TFixedPoint; overload;
    14591798begin
    1460   Result.X := Round(FP.X * 65536);
    1461   Result.Y := Round(FP.Y * 65536);
     1799  Result.X := Round(FP.X * FixedOne);
     1800  Result.Y := Round(FP.Y * FixedOne);
    14621801end;
    14631802
     
    15511890end;
    15521891
     1892function FixedRect(const TopLeft, BottomRight: TFixedPoint): TFixedRect;
     1893begin
     1894  Result.TopLeft := TopLeft;
     1895  Result.BottomRight := BottomRight;
     1896end;
     1897
    15531898function FixedRect(const ARect: TRect): TFixedRect;
    15541899begin
     
    15821927    Bottom := B;
    15831928  end;
     1929end;
     1930
     1931function FloatRect(const TopLeft, BottomRight: TFloatPoint): TFloatRect;
     1932begin
     1933  Result.TopLeft := TopLeft;
     1934  Result.BottomRight := BottomRight;
    15841935end;
    15851936
     
    17452096end;
    17462097
    1747 { Gamma / Pixel Shape Correction table }
    1748 
    1749 procedure SetGamma(Gamma: Single);
    1750 var
    1751   i: Integer;
    1752 begin
    1753   for i := 0 to 255 do
    1754     GAMMA_TABLE[i] := Round(255 * Power(i / 255, Gamma));
    1755 end;
    1756 
    1757 function GetPlatformBackendClass: TCustomBackendClass;
    1758 begin
    1759 {$IFDEF FPC}
    1760   Result := TLCLBackend;
    1761 {$ELSE}
    1762   Result := TGDIBackend;
    1763 {$ENDIF}
    1764 end;
    1765 
    17662098{ TSimpleInterfacedPersistent }
    17672099
     
    18692201
    18702202{ TCustomMap }
     2203
     2204constructor TCustomMap.Create(Width, Height: Integer);
     2205begin
     2206  Create;
     2207  SetSize(Width, Height);
     2208end;
    18712209
    18722210procedure TCustomMap.ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer);
     
    19312269{ TCustomBitmap32 }
    19322270
    1933 constructor TCustomBitmap32.Create;
    1934 begin
    1935   inherited;
    1936 
    1937   InitializeBackend;
     2271constructor TCustomBitmap32.Create(Backend: TCustomBackendClass);
     2272begin
     2273  inherited Create;
     2274
     2275  InitializeBackend(Backend);
    19382276
    19392277  FOuterColor := $00000000;  // by default as full transparency black
     
    19492287end;
    19502288
     2289constructor TCustomBitmap32.Create;
     2290begin
     2291  Create(GetPlatformBackendClass);
     2292end;
     2293
    19512294destructor TCustomBitmap32.Destroy;
    19522295begin
     
    19632306end;
    19642307
    1965 procedure TCustomBitmap32.InitializeBackend;
    1966 begin
    1967   TMemoryBackend.Create(Self);
     2308procedure TCustomBitmap32.InitializeBackend(Backend: TCustomBackendClass);
     2309begin
     2310  Backend.Create(Self);
    19682311end;
    19692312
     
    19882331  http://qc.codegear.com/wc/qcmain.aspx?d=9500
    19892332
    1990   If any backend interface is used within the same procedure in which
     2333  if any backend interface is used within the same procedure in which
    19912334  the owner bitmap is also freed, the magic procedure cleanup will
    19922335  clear that particular interface long after the bitmap and its backend
     
    22392582        // this checks for transparency by comparing the pixel-color of the
    22402583        // temporary bitmap (red masked) with the pixel of our
    2241         // bitmap (white masked). If they match, make that pixel opaque
     2584        // bitmap (white masked). if they match, make that pixel opaque
    22422585        if DstColor = (SrcP^ and $00FFFFFF) then
    22432586          DstP^ := DstColor or $FF000000
     
    22922635
    22932636    // Check if the icon was painted with a merged alpha channel.
    2294     // The happens transparently for new-style 32-bit icons.
     2637    // That happens transparently for new-style 32-bit icons.
    22952638    // For all other bit depths GDI will reset our alpha channel to opaque.
    22962639    ReassignFromMasked := True;
     
    23202663    else if SrcGraphic is TMetaFile then
    23212664      AssignFromGraphicMasked(TargetBitmap, SrcGraphic)
     2665{$IFDEF COMPILER2005_UP}
     2666    else if SrcGraphic is TWICImage then
     2667      AssignFromGraphicPlain(TargetBitmap, SrcGraphic, 0, False)
     2668{$ENDIF}
    23222669{$ENDIF}
    23232670    else
     
    23852732end;
    23862733
     2734constructor TCustomBitmap32.Create(Width, Height: Integer);
     2735begin
     2736  Create;
     2737  SetSize(Width, Height);
     2738end;
     2739
    23872740{$IFDEF BITS_GETTER}
    23882741function TCustomBitmap32.GetBits: PColor32Array;
     
    23912744end;
    23922745{$ENDIF}
     2746
     2747procedure TCustomBitmap32.SetPenPos(const Value: TPoint);
     2748begin
     2749  MoveTo(Value.X, Value.Y);
     2750end;
     2751
     2752procedure TCustomBitmap32.SetPenPosF(const Value: TFixedPoint);
     2753begin
     2754  MoveTo(Value.X, Value.Y);
     2755end;
    23932756
    23942757procedure TCustomBitmap32.SetPixel(X, Y: Integer; Value: TColor32);
     
    24122775begin
    24132776  Result := @Bits[Y * FWidth];
     2777end;
     2778
     2779function TCustomBitmap32.GetPenPos: TPoint;
     2780begin
     2781  Result.X := RasterX;
     2782  Result.Y := RasterY;
     2783end;
     2784
     2785function TCustomBitmap32.GetPenPosF: TFixedPoint;
     2786begin
     2787  Result.X := RasterXF;
     2788  Result.Y := RasterYF;
    24142789end;
    24152790
     
    24382813end;
    24392814
    2440 procedure TCustomBitmap32.Draw(DstX, DstY: Integer; const SrcRect: TRect; Src: TCustomBitmap32);
     2815procedure TCustomBitmap32.Draw(DstX, DstY: Integer; const SrcRect: TRect;
     2816  Src: TCustomBitmap32);
    24412817begin
    24422818  if Assigned(Src) then Src.DrawTo(Self, DstX, DstY, SrcRect);
     
    24502826procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32);
    24512827begin
    2452   BlockTransfer(Dst, 0, 0, Dst.ClipRect, Self, BoundsRect, DrawMode, FOnPixelCombine);
     2828  BlockTransfer(Dst, 0, 0, Dst.ClipRect, Self, BoundsRect, DrawMode,
     2829    FOnPixelCombine);
    24532830end;
    24542831
    24552832procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer);
    24562833begin
    2457   BlockTransfer(Dst, DstX, DstY, Dst.ClipRect, Self, BoundsRect, DrawMode, FOnPixelCombine);
    2458 end;
    2459 
    2460 procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer; const SrcRect: TRect);
    2461 begin
    2462   BlockTransfer(Dst, DstX, DstY, Dst.ClipRect, Self, SrcRect, DrawMode, FOnPixelCombine);
     2834  BlockTransfer(Dst, DstX, DstY, Dst.ClipRect, Self, BoundsRect, DrawMode,
     2835    FOnPixelCombine);
     2836end;
     2837
     2838procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer;
     2839    const SrcRect: TRect);
     2840begin
     2841  BlockTransfer(Dst, DstX, DstY, Dst.ClipRect, Self, SrcRect,
     2842    DrawMode, FOnPixelCombine);
    24632843end;
    24642844
    24652845procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; const DstRect: TRect);
    24662846begin
    2467   StretchTransfer(Dst, DstRect, Dst.ClipRect, Self, BoundsRect, Resampler, DrawMode, FOnPixelCombine);
    2468 end;
    2469 
    2470 procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; const DstRect, SrcRect: TRect);
    2471 begin
    2472   StretchTransfer(Dst, DstRect, Dst.ClipRect, Self, SrcRect, Resampler, DrawMode, FOnPixelCombine);
     2847  StretchTransfer(Dst, DstRect, Dst.ClipRect, Self, BoundsRect, Resampler,
     2848    DrawMode, FOnPixelCombine);
     2849end;
     2850
     2851procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; const DstRect,
     2852  SrcRect: TRect);
     2853begin
     2854  StretchTransfer(Dst, DstRect, Dst.ClipRect, Self, SrcRect, Resampler,
     2855    DrawMode, FOnPixelCombine);
    24732856end;
    24742857
     
    26102993  begin
    26112994    A := C shr 24;  // opacity
    2612     celx := A * GAMMA_TABLE[flrx xor 255];
    2613     cely := GAMMA_TABLE[flry xor 255];
    2614     flrx := A * GAMMA_TABLE[flrx];
    2615     flry := GAMMA_TABLE[flry];
     2995    celx := A * GAMMA_ENCODING_TABLE[flrx xor $FF];
     2996    cely := GAMMA_ENCODING_TABLE[flry xor $FF];
     2997    flrx := A * GAMMA_ENCODING_TABLE[flrx];
     2998    flry := GAMMA_ENCODING_TABLE[flry];
    26162999
    26173000    CombineMem(C, P^, celx * cely shr 16); Inc(P);
     
    26223005  else
    26233006  begin
    2624     celx := GAMMA_TABLE[flrx xor 255];
    2625     cely := GAMMA_TABLE[flry xor 255];
    2626     flrx := GAMMA_TABLE[flrx];
    2627     flry := GAMMA_TABLE[flry];
    2628    
     3007    celx := GAMMA_ENCODING_TABLE[flrx xor $FF];
     3008    cely := GAMMA_ENCODING_TABLE[flry xor $FF];
     3009    flrx := GAMMA_ENCODING_TABLE[flrx];
     3010    flry := GAMMA_ENCODING_TABLE[flry];
     3011
    26293012    CombineMem(MergeReg(C, P^), P^, celx * cely shr 8); Inc(P);
    26303013    CombineMem(MergeReg(C, P^), P^, flrx * cely shr 8); Inc(P, FWidth);
     
    26633046  begin
    26643047    A := C shr 24;  // opacity
    2665     celx := A * GAMMA_TABLE[flrx xor 255];
    2666     cely := GAMMA_TABLE[flry xor 255];
    2667     flrx := A * GAMMA_TABLE[flrx];
    2668     flry := GAMMA_TABLE[flry];
     3048    celx := A * GAMMA_ENCODING_TABLE[flrx xor $FF];
     3049    cely := GAMMA_ENCODING_TABLE[flry xor $FF];
     3050    flrx := A * GAMMA_ENCODING_TABLE[flrx];
     3051    flry := GAMMA_ENCODING_TABLE[flry];
    26693052
    26703053    if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and
     
    26873070  else
    26883071  begin
    2689     celx := GAMMA_TABLE[flrx xor 255];
    2690     cely := GAMMA_TABLE[flry xor 255];
    2691     flrx := GAMMA_TABLE[flrx];
    2692     flry := GAMMA_TABLE[flry];
     3072    celx := GAMMA_ENCODING_TABLE[flrx xor $FF];
     3073    cely := GAMMA_ENCODING_TABLE[flry xor $FF];
     3074    flrx := GAMMA_ENCODING_TABLE[flrx];
     3075    flry := GAMMA_ENCODING_TABLE[flry];
    26933076
    26943077    if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and
     
    27893172begin
    27903173  Pos := (X shr 8) + (Y shr 8) * FWidth;
    2791   Result := Interpolator(GAMMA_TABLE[X and $FF xor 255],
    2792                          GAMMA_TABLE[Y and $FF xor 255],
     3174  Result := Interpolator(GAMMA_ENCODING_TABLE[X and $FF xor $FF],
     3175                         GAMMA_ENCODING_TABLE[Y and $FF xor $FF],
    27933176                         @Bits[Pos], @Bits[Pos + FWidth]);
    27943177end;
     
    28613244{$ELSE}
    28623245asm
     3246{$IFDEF TARGET_x64}
     3247          PUSH    RBP
     3248          SUB     RSP,$30
     3249{$ENDIF}
    28633250          ADD     X, $7F
    28643251          ADD     Y, $7F
     
    28733260{$ENDIF}
    28743261
     3262{$IFDEF TARGET_x64}
     3263          LEA     RSP,[RBP+$30]
     3264          POP     RBP
     3265{$ENDIF}
     3266
    28753267{$ENDIF}
    28763268end;
     
    29223314                       WordRec(TFixedRec(Y).Frac).Hi);
    29233315  EMMS;
     3316end;
     3317
     3318class function TCustomBitmap32.GetPlatformBackendClass: TCustomBackendClass;
     3319begin
     3320  Result := TMemoryBackend;
    29243321end;
    29253322
     
    29863383  end;
    29873384  FStippleCounter := Wrap(FStippleCounter, L);
     3385  {$IFDEF FPC}
     3386  PrevIndex := Trunc(FStippleCounter);
     3387  {$ELSE}
    29883388  PrevIndex := Round(FStippleCounter - 0.5);
    2989   PrevWeight := 255 - Round(255 * (FStippleCounter - PrevIndex));
     3389  {$ENDIF}
     3390  PrevWeight := $FF - Round($FF * (FStippleCounter - PrevIndex));
    29903391  if PrevIndex < 0 then FStippleCounter := L - 1;
    29913392  NextIndex := PrevIndex + 1;
    29923393  if NextIndex >= L then NextIndex := 0;
    2993   if PrevWeight = 255 then Result := FStipplePattern[PrevIndex]
     3394  if PrevWeight = $FF then Result := FStipplePattern[PrevIndex]
    29943395  else
    29953396  begin
     
    31283529    if Wy > 0 then
    31293530    begin
    3130       CombineMem(Value, PDst^, GAMMA_TABLE[(Wy * Wx1) shr 24]);
    3131       Wt := GAMMA_TABLE[Wy shr 8];
     3531      CombineMem(Value, PDst^, GAMMA_ENCODING_TABLE[(Wy * Wx1) shr 24]);
     3532      Wt := GAMMA_ENCODING_TABLE[Wy shr 8];
    31323533      Inc(PDst);
    31333534      for I := 0 to Count - 1 do
     
    31363537        Inc(PDst);
    31373538      end;
    3138       CombineMem(Value, PDst^, GAMMA_TABLE[(Wy * Wx2) shr 24]);
     3539      CombineMem(Value, PDst^, GAMMA_ENCODING_TABLE[(Wy * Wx2) shr 24]);
    31393540    end;
    31403541
     
    31443545    if Wy > 0 then
    31453546    begin
    3146       CombineMem(Value, PDst^, GAMMA_TABLE[(Wy * Wx1) shr 24]);
     3547      CombineMem(Value, PDst^, GAMMA_ENCODING_TABLE[(Wy * Wx1) shr 24]);
    31473548      Inc(PDst);
    3148       Wt := GAMMA_TABLE[Wy shr 8];
     3549      Wt := GAMMA_ENCODING_TABLE[Wy shr 8];
    31493550      for I := 0 to Count - 1 do
    31503551      begin
     
    31523553        Inc(PDst);
    31533554      end;
    3154       CombineMem(Value, PDst^, GAMMA_TABLE[(Wy * Wx2) shr 24]);
     3555      CombineMem(Value, PDst^, GAMMA_ENCODING_TABLE[(Wy * Wx2) shr 24]);
    31553556    end;
    31563557
     
    33223723    if Wx > 0 then
    33233724    begin
    3324       CombineMem(Value, PDst^, GAMMA_TABLE[(Wx * Wy1) shr 24]);
    3325       Wt := GAMMA_TABLE[Wx shr 8];
     3725      CombineMem(Value, PDst^, GAMMA_ENCODING_TABLE[(Wx * Wy1) shr 24]);
     3726      Wt := GAMMA_ENCODING_TABLE[Wx shr 8];
    33263727      Inc(PDst, FWidth);
    33273728      for I := 0 to Count - 1 do
     
    33303731        Inc(PDst, FWidth);
    33313732      end;
    3332       CombineMem(Value, PDst^, GAMMA_TABLE[(Wx * Wy2) shr 24]);
     3733      CombineMem(Value, PDst^, GAMMA_ENCODING_TABLE[(Wx * Wy2) shr 24]);
    33333734    end;
    33343735
     
    33383739    if Wx > 0 then
    33393740    begin
    3340       CombineMem(Value, PDst^, GAMMA_TABLE[(Wx * Wy1) shr 24]);
     3741      CombineMem(Value, PDst^, GAMMA_ENCODING_TABLE[(Wx * Wy1) shr 24]);
    33413742      Inc(PDst, FWidth);
    3342       Wt := GAMMA_TABLE[Wx shr 8];
     3743      Wt := GAMMA_ENCODING_TABLE[Wx shr 8];
    33433744      for I := 0 to Count - 1 do
    33443745      begin
     
    33463747        Inc(PDst, FWidth);
    33473748      end;
    3348       CombineMem(Value, PDst^, GAMMA_TABLE[(Wx * Wy2) shr 24]);
     3749      CombineMem(Value, PDst^, GAMMA_ENCODING_TABLE[(Wx * Wy2) shr 24]);
    33493750    end;
    33503751
     
    35453946          Inc(e, Dy2);
    35463947        end;
    3547         CheckAux := False; // to avoid ugly labels we set this to omit the next check
     3948        CheckAux := False; // to avoid ugly goto we set this to omit the next check
    35483949      end;
    35493950    end;
     
    35653966    end;
    35663967
    3567     // set auxiliary var to indicate that temp is not clipped, since
    3568     // temp still has the unclipped value assigned at setup.
     3968    // set auxiliary var to indicate that term is not clipped, since
     3969    // term still has the unclipped value assigned at setup.
    35693970    CheckAux := False;
    35703971
     
    35723973    if Y2 > Cy2 then
    35733974    begin
    3574       OC := Dx2 * (Cy2 - Y1) + Dx;
     3975      OC := Int64(Dx2) * (Cy2 - Y1) + Dx;
    35753976      term := X1 + OC div Dy2;
    35763977      rem := OC mod Dy2;
    35773978      if rem = 0 then Dec(term);
    3578       CheckAux := True; // set auxiliary var to indicate that temp is clipped
     3979      CheckAux := True; // set auxiliary var to indicate that term is clipped
    35793980    end;
    35803981
     
    35823983    begin
    35833984      term := Cx2;
    3584       CheckAux := True; // set auxiliary var to indicate that temp is clipped
     3985      CheckAux := True; // set auxiliary var to indicate that term is clipped
    35853986    end;
    35863987
     
    36104011    end;
    36114012
    3612     // do we need to skip the last pixel of the line and is temp not clipped?
     4013    // do we need to skip the last pixel of the line and is term not clipped?
    36134014    if not(L or CheckAux) then
    36144015    begin
     
    38144215          Inc(e, Dy2);
    38154216        end;
    3816         CheckAux := False; // to avoid ugly labels we set this to omit the next check
     4217        CheckAux := False; // to avoid ugly goto we set this to omit the next check
    38174218      end;
    38184219    end;
     
    38344235    end;
    38354236
    3836     // set auxiliary var to indicate that temp is not clipped, since
    3837     // temp still has the unclipped value assigned at setup.
     4237    // set auxiliary var to indicate that term is not clipped, since
     4238    // term still has the unclipped value assigned at setup.
    38384239    CheckAux := False;
    38394240
     
    38454246      rem := OC mod Dy2;
    38464247      if rem = 0 then Dec(term);
    3847       CheckAux := True; // set auxiliary var to indicate that temp is clipped
     4248      CheckAux := True; // set auxiliary var to indicate that term is clipped
    38484249    end;
    38494250
     
    38514252    begin
    38524253      term := Cx2;
    3853       CheckAux := True; // set auxiliary var to indicate that temp is clipped
     4254      CheckAux := True; // set auxiliary var to indicate that term is clipped
    38544255    end;
    38554256
     
    38794280    end;
    38804281
    3881     // do we need to skip the last pixel of the line and is temp not clipped?
     4282    // do we need to skip the last pixel of the line and is term not clipped?
    38824283    if not(L or CheckAux) then
    38834284    begin
     
    39154316var
    39164317  n, i: Integer;
    3917   nx, ny, hyp: Integer;
     4318  nx, ny, hyp, hypl: Integer;
    39184319  A: TColor32;
    39194320  h: Single;
     
    39254326    Inc(X1, 127); Inc(Y1, 127); Inc(X2, 127); Inc(Y2, 127);
    39264327    hyp := Hypot(nx, ny);
    3927     if L then Inc(hyp, 65536);
    3928     if hyp < 256 then Exit;
    3929     n := hyp shr 16;
     4328    if hyp = 0 then Exit;
     4329    hypl := hyp + (Integer(L) * FixedOne);
     4330    if (hypl < 256) then Exit;
     4331    n := hypl shr 16;
    39304332    if n > 0 then
    39314333    begin
     
    39404342    end;
    39414343    A := Value shr 24;
    3942     hyp := hyp - n shl 16;
     4344    hyp := hypl - n shl 16;
    39434345    A := A * Cardinal(hyp) shl 8 and $FF000000;
    39444346    SET_T256((X1 + X2 - nx) shr 9, (Y1 + Y2 - ny) shr 9, Value and $00FFFFFF + A);
     
    39574359var
    39584360  n, i: Integer;
    3959   ex, ey, nx, ny, hyp: Integer;
     4361  ex, ey, nx, ny, hyp, hypl: Integer;
    39604362  A: TColor32;
    39614363  h: Single;
     
    39704372    // Check for visibility and clip the coordinates
    39714373    if not ClipLine(Integer(X1), Integer(Y1), Integer(X2), Integer(Y2),
    3972       FFixedClipRect.Left - $10000, FFixedClipRect.Top - $10000,
     4374      FFixedClipRect.Left - $10000,
     4375      FFixedClipRect.Top - $10000,
    39734376      FFixedClipRect.Right, FFixedClipRect.Bottom) then Exit;
    39744377
     
    39884391    end;
    39894392
    3990     // If we are still here, it means that the line touches one or several bitmap
     4393    // if we are still here, it means that the line touches one or several bitmap
    39914394    // boundaries. Use the safe version of antialiased pixel routine
    39924395    try
     
    39944397      Inc(X1, 127); Inc(Y1, 127); Inc(X2, 127); Inc(Y2, 127);
    39954398      hyp := Hypot(nx, ny);
    3996       if L then Inc(Hyp, 65536);
    3997       if hyp < 256 then Exit;
    3998       n := hyp shr 16;
     4399      if hyp = 0 then Exit;
     4400      hypl := hyp + (Integer(L) * FixedOne);
     4401      if hypl < 256 then Exit;
     4402      n := hypl shr 16;
    39994403      if n > 0 then
    40004404      begin
     
    40094413      end;
    40104414      A := Value shr 24;
    4011       hyp := hyp - n shl 16;
    4012       A := A * Longword(hyp) shl 8 and $FF000000;
     4415      hyp := hypl - n shl 16;
     4416      A := A * Cardinal(hyp) shl 8 and $FF000000;
    40134417      SET_TS256(SAR_9(X1 + X2 - nx), SAR_9(Y1 + Y2 - ny), Value and $00FFFFFF + A);
    40144418    finally
     
    40274431var
    40284432  n, i: Integer;
    4029   nx, ny, hyp: Integer;
     4433  nx, ny, hyp, hypl: Integer;
    40304434  A, C: TColor32;
    40314435  ChangedRect: TRect;
     
    40364440    Inc(X1, 127); Inc(Y1, 127); Inc(X2, 127); Inc(Y2, 127);
    40374441    hyp := Hypot(nx, ny);
    4038     if L then Inc(hyp, 65536);
    4039     if hyp < 256 then Exit;
    4040     n := hyp shr 16;
     4442    if hyp = 0 then Exit;
     4443    hypl := hyp + (Integer(L) * FixedOne);
     4444    if hypl < 256 then Exit;
     4445    n := hypl shr 16;
    40414446    if n > 0 then
    40424447    begin
     
    40544459    C := GetStippleColor;
    40554460    A := C shr 24;
    4056     hyp := hyp - n shl 16;
     4461    hyp := hypl - n shl 16;
    40574462    A := A * Longword(hyp) shl 8 and $FF000000;
    40584463    SET_T256((X1 + X2 - nx) shr 9, (Y1 + Y2 - ny) shr 9, C and $00FFFFFF + A);
     
    40704475procedure TCustomBitmap32.LineXSP(X1, Y1, X2, Y2: TFixed; L: Boolean);
    40714476const
    4072   StippleInc: array [Boolean] of Single = (0, 1);
     4477  StippleInc: array [Boolean] of Integer = (0, 1);
    40734478var
    40744479  n, i: Integer;
    4075   sx, sy, ex, ey, nx, ny, hyp: Integer;
     4480  sx, sy, ex, ey, nx, ny, hyp, hypl: Integer;
    40764481  A, C: TColor32;
    40774482  ChangedRect: TRect;
     
    41104515        Integer((Y1 - sy) shr 16)));
    41114516
    4112     // If we are still here, it means that the line touches one or several bitmap
     4517    // if we are still here, it means that the line touches one or several bitmap
    41134518    // boundaries. Use the safe version of antialiased pixel routine
    41144519    nx := X2 - X1; ny := Y2 - Y1;
    41154520    Inc(X1, 127); Inc(Y1, 127); Inc(X2, 127); Inc(Y2, 127);
    41164521    hyp := GR32_Math.Hypot(nx, ny);
    4117     if L then Inc(hyp, 65536);
    4118     if hyp < 256 then Exit;
    4119     n := hyp shr 16;
     4522    if hyp = 0 then Exit;
     4523    hypl := hyp + (Integer(L) * FixedOne);
     4524    if hypl < 256 then Exit;
     4525    n := hypl shr 16;
    41204526    if n > 0 then
    41214527    begin
     
    41324538    C := GetStippleColor;
    41334539    A := C shr 24;
    4134     hyp := hyp - n shl 16;
     4540    hyp := hypl - n shl 16;
    41354541    A := A * Longword(hyp) shl 8 and $FF000000;
    41364542    SET_TS256(SAR_9(X1 + X2 - nx), SAR_9(Y1 + Y2 - ny), C and $00FFFFFF + A);
     
    41994605        CI := EC shr 8;
    42004606        P := @Bits[X1 + Y1 * Width];
    4201         BlendMemEx(Value, P^, GAMMA_TABLE[CI xor 255]);
     4607        BlendMemEx(Value, P^, GAMMA_ENCODING_TABLE[CI xor $FF]);
    42024608        Inc(P, Sx);
    4203         BlendMemEx(Value, P^, GAMMA_TABLE[CI]);
     4609        BlendMemEx(Value, P^, GAMMA_ENCODING_TABLE[CI]);
    42044610      end;
    42054611    end
     
    42174623        CI := EC shr 8;
    42184624        P := @Bits[X1 + Y1 * Width];
    4219         BlendMemEx(Value, P^, GAMMA_TABLE[CI xor 255]);
     4625        BlendMemEx(Value, P^, GAMMA_ENCODING_TABLE[CI xor $FF]);
    42204626        if Sy = 1 then Inc(P, Width) else Dec(P, Width);
    4221         BlendMemEx(Value, P^, GAMMA_TABLE[CI]);
     4627        BlendMemEx(Value, P^, GAMMA_ENCODING_TABLE[CI]);
    42224628      end;
    42234629    end;
     
    42314637var
    42324638  Cx1, Cx2, Cy1, Cy2, PI, Sx, Sy, Dx, Dy, xd, yd, rem, term, tmp: Integer;
    4233   CheckVert, CornerAA, TempClipped: Boolean;
     4639  CheckVert, CornerAA, TermClipped: Boolean;
    42344640  D1, D2: PInteger;
    42354641  EC, EA, ED, D: Word;
     
    43764782          begin
    43774783            Inc(xd, -Sx);
    4378             BlendMemEx(Value, Bits[D1^ + D2^ * Width], GAMMA_TABLE[ED shr 8]);
     4784            BlendMemEx(Value, Bits[D1^ + D2^ * Width], GAMMA_ENCODING_TABLE[ED shr 8]);
    43794785            Dec(ED, EA);
    43804786          end;
     
    43954801        if Sy = -1 then yd := -yd;  // negate back
    43964802        xd := rem;  // restore old xd
    4397         CheckVert := False; // to avoid ugly labels we set this to omit the next check
     4803        CheckVert := False; // to avoid ugly goto we set this to omit the next check
    43984804      end;
    43994805    end;
     
    44134819
    44144820    term := X2;
    4415     TempClipped := False;
     4821    TermClipped := False;
    44164822    CheckVert := False;
    44174823
     
    44364842      end;
    44374843
    4438       TempClipped := True;
     4844      TermClipped := True;
    44394845    end;
    44404846
     
    44424848    begin
    44434849      term := Cx2;
    4444       TempClipped := True;
     4850      TermClipped := True;
    44454851    end;
    44464852
     
    44584864    if not CornerAA then
    44594865    try
    4460       // do we need to skip the last pixel of the line and is temp not clipped?
    4461       if not(L or TempClipped) and not CheckVert then
     4866      // do we need to skip the last pixel of the line and is term not clipped?
     4867      if not(L or TermClipped) and not CheckVert then
    44624868      begin
    44634869        if xd < term then
     
    44674873      end;
    44684874
    4469       Assert(term >= 0);
    44704875      while xd <> term do
    44714876      begin
    44724877        CI := EC shr 8;
    44734878        P := @Bits[D1^ + D2^ * Width];
    4474         BlendMemEx(Value, P^, GAMMA_TABLE[CI xor 255]);
     4879        BlendMemEx(Value, P^, GAMMA_ENCODING_TABLE[CI xor $FF]);
    44754880        Inc(P, PI);
    4476         BlendMemEx(Value, P^, GAMMA_TABLE[CI]);
     4881        BlendMemEx(Value, P^, GAMMA_ENCODING_TABLE[CI]);
    44774882        // check for overflow and jump to next line...
    44784883        D := EC;
     
    44924897      while xd <> rem do
    44934898      begin
    4494         BlendMemEx(Value, Bits[D1^ + D2^ * Width], GAMMA_TABLE[EC shr 8 xor 255]);
     4899        BlendMemEx(Value, Bits[D1^ + D2^ * Width], GAMMA_ENCODING_TABLE[EC shr 8 xor $FF]);
    44954900        Inc(EC, EA);
    44964901        Inc(xd, Sx);
     
    47585163    begin
    47595164      C1 := SetAlpha(clWhite32, Clamp(Contrast * 512 div 100));
    4760       C2 := SetAlpha(clBlack32, Clamp(Contrast * 255 div 100));
     5165      C2 := SetAlpha(clBlack32, Clamp(Contrast * $FF div 100));
    47615166    end
    47625167    else if Contrast < 0 then
    47635168    begin
    47645169      Contrast := -Contrast;
    4765       C1 := SetAlpha(clBlack32, Clamp(Contrast * 255 div 100));
     5170      C1 := SetAlpha(clBlack32, Clamp(Contrast * $FF div 100));
    47665171      C2 := SetAlpha(clWhite32, Clamp(Contrast * 512 div 100));
    47675172    end
     
    48625267    W := Width shl 2;
    48635268    for I := Height - 1 downto 0 do
    4864       Stream.WriteBuffer(PixelPtr[0, I]^, W);
     5269      Stream.WriteBuffer(ScanLine[I]^, W);
    48655270  end
    48665271  else
     
    49915396procedure TCustomBitmap32.ReadData(Stream: TStream);
    49925397var
    4993   w, h: Integer;
     5398  Width, Height: Integer;
    49945399begin
    49955400  try
    4996     Stream.ReadBuffer(w, 4);
    4997     Stream.ReadBuffer(h, 4);
    4998     SetSize(w, h);
     5401    Stream.ReadBuffer(Width, 4);
     5402    Stream.ReadBuffer(Height, 4);
     5403    SetSize(Width, Height);
    49995404    Stream.ReadBuffer(Bits[0], FWidth * FHeight * 4);
    50005405  finally
     
    51015506    OffsetRect(R, Dx, Dy);
    51025507    IntersectRect(R, R, MakeRect(0, 0, Width, Height));
    5103     if R.Top > 0 then FillRect(0, 0, Width, R.Top, FillColor)
    5104     else if R.Top = 0 then FillRect(0, R.Bottom, Width, Height, FillColor);
    5105     if R.Left > 0 then FillRect(0, R.Top, R.Left, R.Bottom, FillColor)
    5106     else if R.Left = 0 then FillRect(R.Right, R.Top, Width, R.Bottom, FillColor);
     5508    if R.Top > 0 then
     5509      FillRect(0, 0, Width, R.Top, FillColor)
     5510    else
     5511    if R.Top = 0 then
     5512      FillRect(0, R.Bottom, Width, Height, FillColor);
     5513    if R.Left > 0 then
     5514      FillRect(0, R.Top, R.Left, R.Bottom, FillColor)
     5515    else
     5516    if R.Left = 0 then
     5517      FillRect(R.Right, R.Top, Width, R.Bottom, FillColor);
    51075518  end;
    51085519
     
    51765587    for J := 0 to Height div 2 - 1 do
    51775588    begin
    5178       P1 := PixelPtr[0, J];
    5179       P2 := PixelPtr[0, J2];
     5589      P1 := PColor32(ScanLine[J]);
     5590      P2 := PColor32(ScanLine[J2]);
    51805591      MoveLongword(P1^, Buffer^, Width);
    51815592      MoveLongword(P2^, P1^, Width);
     
    51925603    for J := 0 to Height - 1 do
    51935604    begin
    5194       MoveLongword(PixelPtr[0, J]^, Dst.PixelPtr[0, J2]^, Width);
     5605      MoveLongword(ScanLine[J]^, Dst.ScanLine[J2]^, Width);
    51955606      Dec(J2);
    51965607    end;
     
    53875798end;
    53885799
    5389 procedure TCustomBitmap32.SetResamplerClassName(Value: string);
     5800procedure TCustomBitmap32.SetResamplerClassName(const Value: string);
    53905801var
    53915802  ResamplerClass: TCustomResamplerClass;
     
    53995810
    54005811{ TBitmap32 }
    5401 
    5402 procedure TBitmap32.InitializeBackend;
    5403 begin
    5404   Backend := GetPlatformBackendClass.Create;
    5405 end;
    54065812
    54075813procedure TBitmap32.FinalizeBackend;
     
    54665872begin
    54675873  Result := (FBackend as IDeviceContextSupport).Handle;
     5874end;
     5875
     5876class function TBitmap32.GetPlatformBackendClass: TCustomBackendClass;
     5877begin
     5878{$IFDEF FPC}
     5879  Result := TLCLBackend;
     5880{$ELSE}
     5881  Result := TGDIBackend;
     5882{$ENDIF}
    54685883end;
    54695884
     
    55675982end;
    55685983
     5984{$IFDEF COMPILER2009_UP}
     5985procedure TBitmap32.DrawTo(Dst: TControlCanvas; DstX, DstY: Integer);
     5986begin
     5987  DrawTo(Dst.Handle, DstX, DstY);
     5988end;
     5989
     5990procedure TBitmap32.DrawTo(Dst: TControlCanvas; const DstRect, SrcRect: TRect);
     5991begin
     5992  DrawTo(Dst.Handle, DstRect, SrcRect);
     5993end;
     5994
     5995procedure TBitmap32.TileTo(Dst: TControlCanvas; const DstRect, SrcRect: TRect);
     5996begin
     5997  TileTo(Dst.Handle, DstRect, SrcRect);
     5998end;
     5999{$ENDIF}
     6000
    55696001procedure TBitmap32.UpdateFont;
    55706002begin
     
    55746006// Text and Fonts //
    55756007
    5576 function TBitmap32.TextExtent(const Text: String): TSize;
     6008function TBitmap32.TextExtent(const Text: string): TSize;
    55776009begin
    55786010  Result := (FBackend as ITextSupport).TextExtent(Text);
     
    55866018// -------------------------------------------------------------------
    55876019
    5588 procedure TBitmap32.Textout(X, Y: Integer; const Text: String);
     6020procedure TBitmap32.Textout(X, Y: Integer; const Text: string);
    55896021begin
    55906022  (FBackend as ITextSupport).Textout(X, Y, Text);
     
    55986030// -------------------------------------------------------------------
    55996031
    5600 procedure TBitmap32.Textout(X, Y: Integer; const ClipRect: TRect; const Text: String);
     6032procedure TBitmap32.Textout(X, Y: Integer; const ClipRect: TRect; const Text: string);
    56016033begin
    56026034  (FBackend as ITextSupport).Textout(X, Y, ClipRect, Text);
     
    56106042// -------------------------------------------------------------------
    56116043
    5612 procedure TBitmap32.Textout(DstRect: TRect; const Flags: Cardinal; const Text: String);
     6044procedure TBitmap32.Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string);
    56136045begin
    56146046  (FBackend as ITextSupport).Textout(DstRect, Flags, Text);
    56156047end;
    56166048
    5617 procedure TBitmap32.TextoutW(DstRect: TRect; const Flags: Cardinal; const Text: Widestring);
     6049procedure TBitmap32.TextoutW(var DstRect: TRect; const Flags: Cardinal; const Text: Widestring);
    56186050begin
    56196051  (FBackend as ITextSupport).TextoutW(DstRect, Flags, Text);
     
    56226054// -------------------------------------------------------------------
    56236055
    5624 function TBitmap32.TextHeight(const Text: String): Integer;
     6056function TBitmap32.TextHeight(const Text: string): Integer;
    56256057begin
    56266058  Result := (FBackend as ITextSupport).TextExtent(Text).cY;
     
    56346066// -------------------------------------------------------------------
    56356067
    5636 function TBitmap32.TextWidth(const Text: String): Integer;
     6068function TBitmap32.TextWidth(const Text: string): Integer;
    56376069begin
    56386070  Result := (FBackend as ITextSupport).TextExtent(Text).cX;
     
    56746106    lfCharSet := Byte(Font.Charset);
    56756107
    5676     // TODO DVT Added cast to fix TFontDataName to String warning. Need to verify is OK
     6108    // TODO DVT Added cast to fix TFontDataName to string warning. Need to verify is OK
    56776109    if AnsiCompareText(Font.Name, 'Default') = 0 then  // do not localize
    56786110      StrPCopy(lfFaceName, string(DefFontData.Name))
     
    57466178begin
    57476179  Sz := 1 shl N - 1;
    5748   Dst := B.PixelPtr[0, 0];
     6180  Dst := PColor32(B.ScanLine[0]);
    57496181  for J := 0 to B.Height - 1 do
    57506182  begin
     
    57706202end;
    57716203
    5772 procedure TBitmap32.RenderText(X, Y: Integer; const Text: String; AALevel: Integer; Color: TColor32);
     6204procedure TBitmap32.RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32);
    57736205var
    57746206  B, B2: TBitmap32;
    57756207  Sz: TSize;
    57766208  Alpha: TColor32;
    5777   PaddedText: String;
     6209  PaddedText: string;
    57786210begin
    57796211  if Empty then Exit;
     
    58356267    DrawMode := dmBlend;
    58366268    MasterAlpha := Alpha;
    5837     CombineMode := Self.CombineMode;
     6269    CombineMode := CombineMode;
    58386270
    58396271    DrawTo(Self, X, Y);
     
    58796311  B := TBitmap32.Create;
    58806312  try
    5881     if AALevel = 0 then
     6313    if AALevel <= 0 then
    58826314    begin
    58836315      Sz := TextExtentW(PaddedText);
     
    59976429{$ENDIF}
    59986430
    5999 procedure TCustomBackend.ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer; ClearBuffer: Boolean);
     6431procedure TCustomBackend.ChangeSize(out Width, Height: Integer; NewWidth, NewHeight: Integer; ClearBuffer: Boolean);
    60006432begin
    60016433  try
  • GraphicTest/Packages/Graphics32/GR32_Backends.pas

    r450 r522  
    4444  Windows, Messages, Controls, Graphics,
    4545{$ENDIF}
    46   Classes, SysUtils, GR32, GR32_Containers, GR32_Image;
     46  Classes, SysUtils, GR32, GR32_Containers, GR32_Image, GR32_Paths;
    4747
    4848type
     49  EBackend = class(Exception);
     50
    4951  ITextSupport = interface(IUnknown)
    5052  ['{225997CC-958A-423E-8B60-9EDE0D3B53B5}']
     
    7072    property Font: TFont read GetFont write SetFont;
    7173    property OnFontChange: TNotifyEvent read GetOnFontChange write SetOnFontChange;
     74  end;
     75
     76  ITextToPathSupport = interface(IUnknown)
     77  ['{6C4037E4-FF4D-4EE2-9C20-B9DB9C64B42D}']
     78    procedure TextToPath(Path: TCustomPath; const X, Y: TFloat; const Text: WideString); overload;
     79    procedure TextToPath(Path: TCustomPath; const DstRect: TFloatRect; const Text: WideString; Flags: Cardinal); overload;
     80    function MeasureText(const DstRect: TFloatRect; const Text: WideString; Flags: Cardinal): TFloatRect;
    7281  end;
    7382
     
    130139implementation
    131140
    132 uses
    133   GR32_LowLevel;
    134 
    135141procedure RequireBackendSupport(TargetBitmap: TCustomBitmap32;
    136142  RequiredInterfaces: array of TGUID;
     
    159165    // TODO: Try to find a back-end that supports the required interfaces
    160166    //       instead of resorting to the default platform back-end class...
    161     TargetBitmap.Backend := GetPlatformBackendClass.Create;
     167    TargetBitmap.Backend := TargetBitmap.GetPlatformBackendClass.Create;
    162168  end
    163169  else
  • GraphicTest/Packages/Graphics32/GR32_Backends_Generic.pas

    r450 r522  
    4949  ActiveX,
    5050{$ENDIF}
    51   SysUtils, Classes, GR32, GR32_Backends;
     51  SysUtils, Classes, GR32;
    5252
    5353type
  • GraphicTest/Packages/Graphics32/GR32_Backends_LCL_Win.pas

    r450 r522  
    4242  {$IFDEF LCLWin32} Windows, {$ENDIF} LCLIntf, LCLType, Types, Controls,
    4343  SysUtils, Classes, Graphics, GR32, GR32_Backends, GR32_Backends_Generic,
    44   GR32_Containers, GR32_Image;
     44  GR32_Containers, GR32_Image, GR32_Paths;
    4545
    4646type
     
    5151  TLCLBackend = class(TCustomBackend, IPaintSupport,
    5252    IBitmapContextSupport, IDeviceContextSupport,
    53     ITextSupport, IFontSupport, ICanvasSupport)
     53    ITextSupport, IFontSupport, ITextToPathSupport, ICanvasSupport)
    5454  private
    5555    procedure FontChangedHandler(Sender: TObject);
     
    104104
    105105    { ITextSupport }
    106     procedure Textout(X, Y: Integer; const Text: String); overload;
    107     procedure Textout(X, Y: Integer; const ClipRect: TRect; const Text: String); overload;
    108     procedure Textout(var DstRect: TRect; const Flags: Cardinal; const Text: String); overload;
    109     function  TextExtent(const Text: String): TSize;
     106    procedure Textout(X, Y: Integer; const Text: string); overload;
     107    procedure Textout(X, Y: Integer; const ClipRect: TRect; const Text: string); overload;
     108    procedure Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string); overload;
     109    function  TextExtent(const Text: string): TSize;
    110110
    111111    procedure TextoutW(X, Y: Integer; const Text: Widestring); overload;
     
    123123    property Font: TFont read GetFont write SetFont;
    124124    property OnFontChange: TNotifyEvent read FOnFontChange write FOnFontChange;
     125
     126    { ITextToPathSupport }
     127    procedure TextToPath(Path: TCustomPath; const X, Y: TFloat; const Text: WideString); overload;
     128    procedure TextToPath(Path: TCustomPath; const DstRect: TFloatRect; const Text: WideString; Flags: Cardinal); overload;
     129    function MeasureText(const DstRect: TFloatRect; const Text: WideString; Flags: Cardinal): TFloatRect;
    125130
    126131    { ICanvasSupport }
     
    182187implementation
    183188
     189uses
     190  GR32_Text_LCL_Win;
     191
    184192var
    185193  StockFont: HFONT;
     
    293301end;
    294302
    295 function TLCLBackend.TextExtent(const Text: String): TSize;
     303function TLCLBackend.TextExtent(const Text: string): TSize;
    296304var
    297305  DC: HDC;
     
    342350end;
    343351
    344 procedure TLCLBackend.Textout(X, Y: Integer; const Text: String);
     352procedure TLCLBackend.Textout(X, Y: Integer; const Text: string);
    345353var
    346354  Extent: TSize;
     
    360368end;
    361369
    362 procedure TLCLBackend.TextoutW(X, Y: Integer; const Text: WideString);
     370procedure TLCLBackend.TextoutW(X, Y: Integer; const Text: Widestring);
    363371var
    364372  Extent: TSize;
     
    378386end;
    379387
    380 procedure TLCLBackend.TextoutW(X, Y: Integer; const ClipRect: TRect;
    381   const Text: Widestring);
     388procedure TLCLBackend.TextoutW(X, Y: Integer; const ClipRect: TRect; const Text: Widestring);
    382389var
    383390  Extent: TSize;
     
    386393
    387394  if not FOwner.MeasuringMode then
    388     ExtTextoutW(Handle, X, Y, ETO_CLIPPED, @ClipRect, PWideChar(Text),
    389       Length(Text), nil);
     395    ExtTextoutW(Handle, X, Y, ETO_CLIPPED, @ClipRect, PWideChar(Text), Length(Text), nil);
    390396
    391397  Extent := TextExtentW(Text);
     
    393399end;
    394400
    395 procedure TLCLBackend.Textout(X, Y: Integer; const ClipRect: TRect;
    396   const Text: String);
     401procedure TLCLBackend.Textout(X, Y: Integer; const ClipRect: TRect; const Text: string);
    397402var
    398403  Extent: TSize;
     
    407412end;
    408413
    409 procedure TLCLBackend.TextoutW(var DstRect: TRect; const Flags: Cardinal;
    410   const Text: Widestring);
     414procedure TLCLBackend.TextoutW(var DstRect: TRect; const Flags: Cardinal; const Text: Widestring);
    411415begin
    412416  UpdateFont;
     
    435439end;
    436440
    437 procedure TLCLBackend.Textout(var DstRect: TRect; const Flags: Cardinal;
    438   const Text: String);
     441procedure TLCLBackend.TextToPath(Path: TCustomPath; const X, Y: TFloat;
     442  const Text: WideString);
     443var
     444  R: TFloatRect;
     445begin
     446  R := FloatRect(X, Y, X, Y);
     447  GR32_Text_LCL_Win.TextToPath(Font.Handle, Path, R, Text, 0);
     448end;
     449
     450procedure TLCLBackend.TextToPath(Path: TCustomPath; const DstRect: TFloatRect;
     451  const Text: WideString; Flags: Cardinal);
     452begin
     453  GR32_Text_LCL_Win.TextToPath(Font.Handle, Path, DstRect, Text, Flags);
     454end;
     455
     456function TLCLBackend.MeasureText(const DstRect: TFloatRect;
     457  const Text: WideString; Flags: Cardinal): TFloatRect;
     458begin
     459  Result := GR32_Text_LCL_Win.MeasureText(Font.Handle, DstRect, Text, Flags);
     460end;
     461
     462procedure TLCLBackend.Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string);
    439463begin
    440464  UpdateFont;
     
    703727procedure TLCLMemoryBackend.DrawTo(hDst: HDC; DstX, DstY: Integer);
    704728var
    705   Bitmap        : HBITMAP;
    706   DeviceContext : HDC;
    707   Buffer        : Pointer;
    708   OldObject     : HGDIOBJ;
     729  Bitmap: HBITMAP;
     730  DeviceContext: HDC;
     731  Buffer: Pointer;
     732  OldObject: HGDIOBJ;
    709733begin
    710734  {$IFDEF LCLWin32}
     
    746770procedure TLCLMemoryBackend.DrawTo(hDst: HDC; const DstRect, SrcRect: TRect);
    747771var
    748   Bitmap        : HBITMAP;
    749   DeviceContext : HDC;
    750   Buffer        : Pointer;
    751   OldObject     : HGDIOBJ;
     772  Bitmap: HBITMAP;
     773  DeviceContext: HDC;
     774  Buffer: Pointer;
     775  OldObject: HGDIOBJ;
    752776begin
    753777  {$IFDEF LCLWin32}
     
    761785    if DeviceContext <> 0 then
    762786    try
     787      Buffer := nil;
    763788      Bitmap := CreateDIBSection(DeviceContext, FBitmapInfo, DIB_RGB_COLORS,
    764789        Buffer, 0, 0);
  • GraphicTest/Packages/Graphics32/GR32_Backends_VCL.pas

    r450 r522  
    4040uses
    4141  SysUtils, Classes, Windows, Graphics, GR32, GR32_Backends, GR32_Containers,
    42   GR32_Image, GR32_Backends_Generic;
     42  GR32_Image, GR32_Backends_Generic, GR32_Paths;
    4343
    4444type
     
    5050  TGDIBackend = class(TCustomBackend, IPaintSupport,
    5151    IBitmapContextSupport, IDeviceContextSupport,
    52     ITextSupport, IFontSupport, ICanvasSupport)
     52    ITextSupport, IFontSupport, ICanvasSupport, ITextToPathSupport)
    5353  private
    5454    procedure FontChangedHandler(Sender: TObject);
     
    9696
    9797    procedure Draw(const DstRect, SrcRect: TRect; hSrc: HDC); overload;
    98     procedure DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; DstX, DstY: Integer); overload;
    99     procedure DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; const DstRect, SrcRect: TRect); overload;
     98    procedure DrawTo(hDst: HDC; DstX, DstY: Integer); overload;
     99    procedure DrawTo(hDst: HDC; const DstRect, SrcRect: TRect); overload;
    100100
    101101    property Handle: HDC read GetHandle;
    102102
    103103    { ITextSupport }
    104     procedure Textout(X, Y: Integer; const Text: String); overload;
    105     procedure Textout(X, Y: Integer; const ClipRect: TRect; const Text: String); overload;
    106     procedure Textout(var DstRect: TRect; const Flags: Cardinal; const Text: String); overload;
    107     function  TextExtent(const Text: String): TSize;
     104    procedure Textout(X, Y: Integer; const Text: string); overload;
     105    procedure Textout(X, Y: Integer; const ClipRect: TRect; const Text: string); overload;
     106    procedure Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string); overload;
     107    function  TextExtent(const Text: string): TSize;
    108108
    109109    procedure TextoutW(X, Y: Integer; const Text: Widestring); overload;
     
    121121    property Font: TFont read GetFont write SetFont;
    122122    property OnFontChange: TNotifyEvent read FOnFontChange write FOnFontChange;
     123
     124    { ITextToPathSupport }
     125    procedure TextToPath(Path: TCustomPath; const X, Y: TFloat; const Text: WideString); overload;
     126    procedure TextToPath(Path: TCustomPath; const DstRect: TFloatRect; const Text: WideString; Flags: Cardinal); overload;
     127    function MeasureText(const DstRect: TFloatRect; const Text: WideString; Flags: Cardinal): TFloatRect;
    123128
    124129    { ICanvasSupport }
     
    158163    procedure DoPaintRect(ABuffer: TBitmap32; ARect: TRect; ACanvas: TCanvas);
    159164
    160     function GetHandle: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; // Dummy
     165    function GetHandle: HDC; // Dummy
    161166  protected
    162167    FBitmapInfo: TBitmapInfo;
     
    173178
    174179    { IDeviceContextSupport }
    175     procedure Draw(const DstRect, SrcRect: TRect; hSrc: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}); overload;
    176     procedure DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; DstX, DstY: Integer); overload;
    177     procedure DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; const DstRect, SrcRect: TRect); overload;
     180    procedure Draw(const DstRect, SrcRect: TRect; hSrc: HDC); overload;
     181    procedure DrawTo(hDst: HDC; DstX, DstY: Integer); overload;
     182    procedure DrawTo(hDst: HDC; const DstRect, SrcRect: TRect); overload;
    178183  end;
    179184
    180185implementation
     186
     187uses
     188  GR32_Text_VCL;
    181189
    182190var
     
    227235
    228236  if FBits = nil then
    229     raise Exception.Create(RCStrCannotAllocateDIBHandle);
     237    raise EBackend.Create(RCStrCannotAllocateDIBHandle);
    230238
    231239  FHDC := CreateCompatibleDC(0);
     
    235243    FBitmapHandle := 0;
    236244    FBits := nil;
    237     raise Exception.Create(RCStrCannotCreateCompatibleDC);
     245    raise EBackend.Create(RCStrCannotCreateCompatibleDC);
    238246  end;
    239247
     
    245253    FBitmapHandle := 0;
    246254    FBits := nil;
    247     raise Exception.Create(RCStrCannotSelectAnObjectIntoDC);
    248   end;
     255    raise EBackend.Create(RCStrCannotSelectAnObjectIntoDC);
     256  end;
     257end;
     258
     259function TGDIBackend.MeasureText(const DstRect: TFloatRect;
     260  const Text: WideString; Flags: Cardinal): TFloatRect;
     261begin
     262  Result := GR32_Text_VCL.MeasureText(Font.Handle, DstRect, Text, Flags);
    249263end;
    250264
     
    292306end;
    293307
    294 function TGDIBackend.TextExtent(const Text: String): TSize;
    295 var
    296   DC: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF};
     308function TGDIBackend.TextExtent(const Text: string): TSize;
     309var
     310  DC: HDC;
    297311  OldFont: HGDIOBJ;
    298312begin
     
    318332function TGDIBackend.TextExtentW(const Text: Widestring): TSize;
    319333var
    320   DC: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF};
     334  DC: HDC;
    321335  OldFont: HGDIOBJ;
    322336begin
     
    341355end;
    342356
    343 procedure TGDIBackend.Textout(X, Y: Integer; const Text: String);
     357procedure TGDIBackend.Textout(X, Y: Integer; const Text: string);
    344358var
    345359  Extent: TSize;
     
    390404end;
    391405
    392 procedure TGDIBackend.Textout(X, Y: Integer; const ClipRect: TRect; const Text: String);
     406procedure TGDIBackend.Textout(X, Y: Integer; const ClipRect: TRect; const Text: string);
    393407var
    394408  Extent: TSize;
     
    411425
    412426  FOwner.Changed(DstRect);
     427end;
     428
     429procedure TGDIBackend.TextToPath(Path: TCustomPath; const X, Y: TFloat;
     430  const Text: WideString);
     431var
     432  R: TFloatRect;
     433begin
     434  R := FloatRect(X, Y, X, Y);
     435  GR32_Text_VCL.TextToPath(Font.Handle, Path, R, Text, 0);
     436end;
     437
     438procedure TGDIBackend.TextToPath(Path: TCustomPath; const DstRect: TFloatRect;
     439  const Text: WideString; Flags: Cardinal);
     440begin
     441  GR32_Text_VCL.TextToPath(Font.Handle, Path, DstRect, Text, Flags);
    413442end;
    414443
     
    430459end;
    431460
    432 procedure TGDIBackend.Textout(var DstRect: TRect; const Flags: Cardinal; const Text: String);
     461procedure TGDIBackend.Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string);
    433462begin
    434463  UpdateFont;
     
    440469end;
    441470
    442 procedure TGDIBackend.DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; DstX, DstY: Integer);
     471procedure TGDIBackend.DrawTo(hDst: HDC; DstX, DstY: Integer);
    443472begin
    444473  StretchDIBits(
     
    447476end;
    448477
    449 procedure TGDIBackend.DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; const DstRect, SrcRect: TRect);
     478procedure TGDIBackend.DrawTo(hDst: HDC; const DstRect, SrcRect: TRect);
    450479begin
    451480  StretchBlt(
     
    486515end;
    487516
    488 function TGDIBackend.GetHandle: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF};
     517function TGDIBackend.GetHandle: HDC;
    489518begin
    490519  Result := FHDC;
     
    512541end;
    513542
    514 procedure TGDIBackend.Draw(const DstRect, SrcRect: TRect; hSrc: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF});
     543procedure TGDIBackend.Draw(const DstRect, SrcRect: TRect; hSrc: HDC);
    515544begin
    516545  if FOwner.Empty then Exit;
     
    642671var
    643672  Bitmap        : HBITMAP;
    644   DeviceContext : {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF};
     673  DeviceContext : HDC;
    645674  Buffer        : Pointer;
    646675  OldObject     : HGDIOBJ;
     
    671700        end;
    672701      end else
    673         raise Exception.Create('Can''t create compatible DC''');
     702        raise EBackend.Create(RCStrCannotCreateCompatibleDC);
    674703    finally
    675704      DeleteDC(DeviceContext);
     
    678707end;
    679708
    680 procedure TGDIMemoryBackend.Draw(const DstRect, SrcRect: TRect; hSrc: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF});
     709procedure TGDIMemoryBackend.Draw(const DstRect, SrcRect: TRect; hSrc: HDC);
    681710begin
    682711  if FOwner.Empty then Exit;
    683712
    684713  if not FOwner.MeasuringMode then
    685     raise Exception.Create('Not supported!');
     714    raise EBackend.Create('Not supported!');
    686715
    687716  FOwner.Changed(DstRect);
    688717end;
    689718
    690 procedure TGDIMemoryBackend.DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; DstX, DstY: Integer);
     719procedure TGDIMemoryBackend.DrawTo(hDst: HDC; DstX, DstY: Integer);
    691720var
    692721  Bitmap        : HBITMAP;
    693   DeviceContext : {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF};
     722  DeviceContext : HDC;
    694723  Buffer        : Pointer;
    695724  OldObject     : HGDIOBJ;
    696725begin
    697   if SetDIBitsToDevice(hDst, DstX, DstY,
    698     FOwner.Width, FOwner.Height, 0, 0, 0, FOwner.Height, FBits, FBitmapInfo,
    699     DIB_RGB_COLORS) = 0 then
     726  if SetDIBitsToDevice(hDst, DstX, DstY, FOwner.Width, FOwner.Height, 0, 0, 0,
     727    FOwner.Height, FBits, FBitmapInfo, DIB_RGB_COLORS) = 0 then
    700728  begin
    701729    // create compatible device context
     
    720748        end;
    721749      end else
    722         raise Exception.Create('Can''t create compatible DC''');
     750        raise EBackend.Create(RCStrCannotCreateCompatibleDC);
    723751    finally
    724752      DeleteDC(DeviceContext);
     
    727755end;
    728756
    729 procedure TGDIMemoryBackend.DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF};
     757procedure TGDIMemoryBackend.DrawTo(hDst: HDC;
    730758  const DstRect, SrcRect: TRect);
    731759var
    732760  Bitmap        : HBITMAP;
    733   DeviceContext : {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF};
     761  DeviceContext : HDC;
    734762  Buffer        : Pointer;
    735763  OldObject     : HGDIOBJ;
     
    761789        end;
    762790      end else
    763         raise Exception.Create('Can''t create compatible DC''');
     791        raise EBackend.Create(RCStrCannotCreateCompatibleDC);
    764792    finally
    765793      DeleteDC(DeviceContext);
     
    768796end;
    769797
    770 function TGDIMemoryBackend.GetHandle: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF};
     798function TGDIMemoryBackend.GetHandle: HDC;
    771799begin
    772800  Result := 0;
  • GraphicTest/Packages/Graphics32/GR32_Bindings.pas

    r450 r522  
    8080    procedure Clear;
    8181
    82     procedure Add(FunctionID: Integer; Proc: Pointer; CPUFeatures: TCPUFeatures = []; Flags: Integer = 0);
     82    procedure Add(FunctionID: Integer; Proc: Pointer; CPUFeatures: TCPUFeatures = [];
     83      Flags: Integer = 0);
    8384
    8485    // function rebinding support
     
    116117    Registers := TList.Create;
    117118  Result := TFunctionRegistry.Create;
     119  {$IFDEF NEXTGEN}
     120  Result.__ObjAddRef;
     121  {$ENDIF}
    118122  Result.Name := Name;
    119123  Registers.Add(Result);
  • GraphicTest/Packages/Graphics32/GR32_Blend.pas

    r450 r522  
    4141 *      - 2004/08/25 - ColorDiv
    4242 *
     43 *  Christian-W. Budde
     44 *      - 2019/04/01 - Refactoring
     45 *
    4346 * ***** END LICENSE BLOCK ***** *)
    4447
     
    4851
    4952uses
    50   GR32, GR32_System, GR32_Bindings, SysUtils;
     53  GR32, GR32_Bindings, SysUtils;
    5154
    5255var
     
    5760  TBlendReg    = function(F, B: TColor32): TColor32;
    5861  TBlendMem    = procedure(F: TColor32; var B: TColor32);
     62  TBlendMems   = procedure(F: TColor32; B: PColor32; Count: Integer);
    5963  TBlendRegEx  = function(F, B, M: TColor32): TColor32;
    6064  TBlendMemEx  = procedure(F: TColor32; var B: TColor32; M: TColor32);
     65  TBlendRegRGB = function(F, B, W: TColor32): TColor32;
     66  TBlendMemRGB = procedure(F: TColor32; var B: TColor32; W: TColor32);
     67{$IFDEF TEST_BLENDMEMRGB128SSE4}
     68  TBlendMemRGB128 = procedure(F: TColor32; var B: TColor32; W: UInt64);
     69{$ENDIF}
    6170  TBlendLine   = procedure(Src, Dst: PColor32; Count: Integer);
    6271  TBlendLineEx = procedure(Src, Dst: PColor32; Count: Integer; M: TColor32);
     72  TBlendLine1  = procedure(Src: TColor32; Dst: PColor32; Count: Integer);
    6373  TCombineReg  = function(X, Y, W: TColor32): TColor32;
    6474  TCombineMem  = procedure(X: TColor32; var Y: TColor32; W: TColor32);
     
    7484  BlendReg: TBlendReg;
    7585  BlendMem: TBlendMem;
     86  BlendMems: TBlendMems;
    7687
    7788  BlendRegEx: TBlendRegEx;
    7889  BlendMemEx: TBlendMemEx;
    7990
     91  BlendRegRGB: TBlendRegRGB;
     92  BlendMemRGB: TBlendMemRGB;
     93{$IFDEF TEST_BLENDMEMRGB128SSE4}
     94  BlendMemRGB128: TBlendMemRGB128;
     95{$ENDIF}
     96
    8097  BlendLine: TBlendLine;
    8198  BlendLineEx: TBlendLineEx;
     99  BlendLine1: TBlendLine1;
    82100
    83101  CombineReg: TCombineReg;
     
    93111  MergeLine: TBlendLine;
    94112  MergeLineEx: TBlendLineEx;
     113  MergeLine1: TBlendLine1;
    95114
    96115{ Color algebra functions }
     
    105124  ColorExclusion: TBlendReg;
    106125  ColorScale: TBlendReg;
     126  ColorScreen: TBlendReg;
     127  ColorDodge: TBlendReg;
     128  ColorBurn: TBlendReg;
     129
     130{ Blended color algebra functions }
     131  BlendColorAdd: TBlendReg;
     132  BlendColorModulate: TBlendReg;
    107133
    108134{ Special LUT pointers }
     
    119145{ Access to alpha composite functions corresponding to a combine mode }
    120146
     147type
     148  PBlendReg = ^TBlendReg;
     149  PBlendMem = ^TBlendMem;
     150  PBlendRegEx = ^TBlendRegEx;
     151  PBlendMemEx = ^TBlendMemEx;
     152  PBlendLine = ^TBlendLine;
     153  PBlendLineEx = ^TBlendLineEx;
     154
     155  TBlendRegCombineModeArray = array[TCombineMode] of PBlendReg;
     156  TBlendMemCombineModeArray = array[TCombineMode] of PBlendMem;
     157  TBlendRegExCombineModeArray = array[TCombineMode] of PBlendRegEx;
     158  TBlendMemExCombineModeArray = array[TCombineMode] of PBlendMemEx;
     159  TBlendLineCombineModeArray = array[TCombineMode] of PBlendLine;
     160  TBlendLineExCombineModeArray = array[TCombineMode] of PBlendLineEx;
     161
    121162const
    122   BLEND_REG: array[TCombineMode] of ^TBlendReg = ((@@BlendReg),(@@MergeReg));
    123   BLEND_MEM: array[TCombineMode] of ^TBlendMem = ((@@BlendMem),(@@MergeMem));
    124   BLEND_REG_EX: array[TCombineMode] of ^TBlendRegEx = ((@@BlendRegEx),(@@MergeRegEx));
    125   BLEND_MEM_EX: array[TCombineMode] of ^TBlendMemEx = ((@@BlendMemEx),(@@MergeMemEx));
    126   BLEND_LINE: array[TCombineMode] of ^TBlendLine = ((@@BlendLine),(@@MergeLine));
    127   BLEND_LINE_EX: array[TCombineMode] of ^TBlendLineEx = ((@@BlendLineEx),(@@MergeLineEx));
     163  BLEND_REG: TBlendRegCombineModeArray = ((@@BlendReg),(@@MergeReg));
     164  BLEND_MEM: TBlendMemCombineModeArray = ((@@BlendMem),(@@MergeMem));
     165  BLEND_REG_EX: TBlendRegExCombineModeArray = ((@@BlendRegEx),(@@MergeRegEx));
     166  BLEND_MEM_EX: TBlendMemExCombineModeArray = ((@@BlendMemEx),(@@MergeMemEx));
     167  BLEND_LINE: TBlendLineCombineModeArray = ((@@BlendLine),(@@MergeLine));
     168  BLEND_LINE_EX: TBlendLineExCombineModeArray = ((@@BlendLineEx),(@@MergeLineEx));
    128169
    129170var
     
    134175{$ENDIF}
    135176
    136 implementation
    137 
    138 {$IFDEF TARGET_x86}
    139 uses GR32_LowLevel;
    140 {$ENDIF}
    141 
    142177var
    143178  RcTable: array [Byte, Byte] of Byte;
    144179  DivTable: array [Byte, Byte] of Byte;
     180
     181implementation
     182
     183uses
     184  GR32_LowLevel,
     185{$IFNDEF PUREPASCAL}
     186  GR32_BlendASM,
     187{$IFNDEF OMIT_MMX}
     188  GR32_BlendMMX,
     189{$ENDIF}
     190{$IFNDEF OMIT_SSE2}
     191  GR32_BlendSSE2,
     192{$ENDIF}
     193{$ENDIF}
     194  GR32_System;
    145195
    146196{$IFDEF OMIT_MMX}
     
    173223  end;
    174224
     225  Af := @DivTable[FA];
     226  Ab := @DivTable[not FA];
    175227  with BX do
    176228  begin
    177     Af := @DivTable[FA];
    178     Ab := @DivTable[not FA];
    179229    R := Af[FX.R] + Ab[R];
    180230    G := Af[FX.G] + Ab[G];
    181231    B := Af[FX.B] + Ab[B];
     232    A := $FF;
    182233  end;
    183234  Result := B;
     
    201252  end;
    202253
     254  Af := @DivTable[FA];
     255  Ab := @DivTable[not FA];
    203256  with BX do
    204257  begin
    205     Af := @DivTable[FA];
    206     Ab := @DivTable[not FA];
    207258    R := Af[FX.R] + Ab[R];
    208259    G := Af[FX.G] + Ab[G];
    209260    B := Af[FX.B] + Ab[B];
     261    A := $FF;
     262  end;
     263end;
     264
     265procedure BlendMems_Pas(F: TColor32; B: PColor32; Count: Integer);
     266begin
     267  while Count > 0 do
     268  begin
     269    BlendMem(F, B^);
     270    Inc(B);
     271    Dec(Count);
    210272  end;
    211273end;
     
    233295  end;
    234296
     297  Ab := @DivTable[255 - M];
    235298  with BX do
    236299  begin
    237     Af := @DivTable[M];
    238     Ab := @DivTable[255 - M];
    239300    R := Af[FX.R] + Ab[R];
    240301    G := Af[FX.G] + Ab[G];
    241302    B := Af[FX.B] + Ab[B];
     303    A := $FF;
    242304  end;
    243305  Result := B;
     
    265327  end;
    266328
     329  Ab := @DivTable[255 - M];
    267330  with BX do
    268331  begin
    269     Af := @DivTable[M];
    270     Ab := @DivTable[255 - M];
    271332    R := Af[FX.R] + Ab[R];
    272333    G := Af[FX.G] + Ab[G];
    273334    B := Af[FX.B] + Ab[B];
     335    A := $FF;
     336  end;
     337end;
     338
     339function BlendRegRGB_Pas(F, B, W: TColor32): TColor32;
     340var
     341  FX: TColor32Entry absolute F;
     342  BX: TColor32Entry absolute B;
     343  WX: TColor32Entry absolute W;
     344  RX: TColor32Entry absolute Result;
     345begin
     346  RX.R := (FX.R - BX.R) * WX.B div 255 + BX.R;
     347  RX.G := (FX.G - BX.G) * WX.G div 255 + BX.G;
     348  RX.B := (FX.B - BX.B) * WX.R div 255 + BX.B;
     349end;
     350
     351procedure BlendMemRGB_Pas(F: TColor32; var B: TColor32; W: TColor32);
     352var
     353  FX: TColor32Entry absolute F;
     354  BX: TColor32Entry absolute B;
     355  WX: TColor32Entry absolute W;
     356begin
     357  BX.R := (FX.R - BX.R) * WX.B div 255 + BX.R;
     358  BX.G := (FX.G - BX.G) * WX.G div 255 + BX.G;
     359  BX.B := (FX.B - BX.B) * WX.R div 255 + BX.B;
     360end;
     361
     362procedure BlendLine1_Pas(Src: TColor32; Dst: PColor32; Count: Integer);
     363begin
     364  while Count > 0 do
     365  begin
     366    BlendMem(Src, Dst^);
     367    Inc(Dst);
     368    Dec(Count);
    274369  end;
    275370end;
     
    315410  end;
    316411
     412  Af := @DivTable[W];
     413  Ab := @DivTable[255 - W];
    317414  with Xe do
    318415  begin
    319     Af := @DivTable[W];
    320     Ab := @DivTable[255 - W];
    321416    R := Ab[Ye.R] + Af[R];
    322417    G := Ab[Ye.G] + Af[G];
    323418    B := Ab[Ye.B] + Af[B];
     419    A := Ab[Ye.A] + Af[A];
    324420  end;
    325421  Result := X;
     
    343439  end;
    344440
     441  Af := @DivTable[W];
     442  Ab := @DivTable[255 - W];
    345443  with Xe do
    346444  begin
    347     Af := @DivTable[W];
    348     Ab := @DivTable[255 - W];
    349445    R := Ab[Ye.R] + Af[R];
    350446    G := Ab[Ye.G] + Af[G];
    351447    B := Ab[Ye.B] + Af[B];
     448    A := Ab[Ye.A] + Af[A];
    352449  end;
    353450  Y := X;
     
    367464function MergeReg_Pas(F, B: TColor32): TColor32;
    368465var
    369  Fa, Ba, Wa: TColor32;
    370  Fw, Bw: PByteArray;
    371  Fx: TColor32Entry absolute F;
    372  Bx: TColor32Entry absolute B;
    373  Rx: TColor32Entry absolute Result;
    374 begin
    375  Fa := F shr 24;
    376  Ba := B shr 24;
    377  if Fa = $FF then
    378    Result := F
    379  else if Fa = $0 then
    380    Result := B
    381  else if Ba = $0 then
    382    Result := F
    383  else
    384  begin
    385    Rx.A := DivTable[Fa xor 255, Ba xor 255] xor 255;
    386    Wa := RcTable[Rx.A, Fa];
    387    Fw := @DivTable[Wa];
    388    Bw := @DivTable[Wa xor $ff];
    389    Rx.R := Fw[Fx.R] + Bw[Bx.R];
    390    Rx.G := Fw[Fx.G] + Bw[Bx.G];
    391    Rx.B := Fw[Fx.B] + Bw[Bx.B];
    392  end;
     466  Fa, Ba, Wa: TColor32;
     467  Fw, Bw: PByteArray;
     468  Fx: TColor32Entry absolute F;
     469  Bx: TColor32Entry absolute B;
     470  Rx: TColor32Entry absolute Result;
     471begin
     472  Fa := F shr 24;
     473  Ba := B shr 24;
     474  if Fa = $FF then
     475    Result := F
     476  else if Fa = $0 then
     477    Result := B
     478  else if Ba = $0 then
     479    Result := F
     480  else
     481  begin
     482    Rx.A := DivTable[Fa xor 255, Ba xor 255] xor 255;
     483    Wa := RcTable[Rx.A, Fa];
     484    Fw := @DivTable[Wa];
     485    Bw := @DivTable[Wa xor $FF];
     486    Rx.R := Fw[Fx.R] + Bw[Bx.R];
     487    Rx.G := Fw[Fx.G] + Bw[Bx.G];
     488    Rx.B := Fw[Fx.B] + Bw[Bx.B];
     489  end;
    393490end;
    394491
     
    406503begin
    407504  B := MergeReg(DivTable[M, F shr 24] shl 24 or F and $00FFFFFF, B);
     505end;
     506
     507procedure MergeLine1_Pas(Src: TColor32; Dst: PColor32; Count: Integer);
     508begin
     509  while Count > 0 do
     510  begin
     511    Dst^ := MergeReg(Src, Dst^);
     512    Inc(Dst);
     513    Dec(Count);
     514  end;
    408515end;
    409516
     
    435542procedure EMMS_Pas;
    436543begin
    437 //Dummy
     544  // Dummy
    438545end;
    439546
    440547function LightenReg_Pas(C: TColor32; Amount: Integer): TColor32;
    441548var
    442   r, g, b, a: Integer;
     549  r, g, b: Integer;
    443550  CX: TColor32Entry absolute C;
    444551  RX: TColor32Entry absolute Result;
    445552begin
    446   a := CX.A;
    447553  r := CX.R;
    448554  g := CX.G;
     
    457563  if b > 255 then b := 255 else if b < 0 then b := 0;
    458564
    459   RX.A := a;
     565  // preserve alpha
     566  RX.A := CX.A;
    460567  RX.R := r;
    461568  RX.G := g;
     
    467574function ColorAdd_Pas(C1, C2: TColor32): TColor32;
    468575var
    469   r1, g1, b1, a1: Integer;
    470   r2, g2, b2, a2: Integer;
    471 begin
    472   a1 := C1 shr 24;
    473   r1 := C1 and $00FF0000;
    474   g1 := C1 and $0000FF00;
    475   b1 := C1 and $000000FF;
    476 
    477   a2 := C2 shr 24;
    478   r2 := C2 and $00FF0000;
    479   g2 := C2 and $0000FF00;
    480   b2 := C2 and $000000FF;
    481 
    482   a1 := a1 + a2;
    483   r1 := r1 + r2;
    484   g1 := g1 + g2;
    485   b1 := b1 + b2;
    486 
    487   if a1 > $FF then a1 := $FF;
    488   if r1 > $FF0000 then r1 := $FF0000;
    489   if g1 > $FF00 then g1 := $FF00;
    490   if b1 > $FF then b1 := $FF;
    491 
    492   Result := a1 shl 24 + r1 + g1 + b1;
     576  Xe: TColor32Entry absolute C1;
     577  Ye: TColor32Entry absolute C2;
     578  R: TColor32Entry absolute Result;
     579begin
     580  R.A := Clamp(Xe.A + Ye.A, 255);
     581  R.R := Clamp(Xe.R + Ye.R, 255);
     582  R.G := Clamp(Xe.G + Ye.G, 255);
     583  R.B := Clamp(Xe.B + Ye.B, 255);
    493584end;
    494585
    495586function ColorSub_Pas(C1, C2: TColor32): TColor32;
    496587var
    497   r1, g1, b1, a1: Integer;
    498   r2, g2, b2, a2: Integer;
    499 begin
    500   a1 := C1 shr 24;
    501   r1 := C1 and $00FF0000;
    502   g1 := C1 and $0000FF00;
    503   b1 := C1 and $000000FF;
    504 
    505   r1 := r1 shr 16;
    506   g1 := g1 shr 8;
    507 
    508   a2 := C2 shr 24;
    509   r2 := C2 and $00FF0000;
    510   g2 := C2 and $0000FF00;
    511   b2 := C2 and $000000FF;
    512 
    513   r2 := r2 shr 16;
    514   g2 := g2 shr 8;
    515 
    516   a1 := a1 - a2;
    517   r1 := r1 - r2;
    518   g1 := g1 - g2;
    519   b1 := b1 - b2;
    520 
    521   if a1 < 0 then a1 := 0;
    522   if r1 < 0 then r1 := 0;
    523   if g1 < 0 then g1 := 0;
    524   if b1 < 0 then b1 := 0;
    525 
    526   Result := a1 shl 24 + r1 shl 16 + g1 shl 8 + b1;
     588  Xe: TColor32Entry absolute C1;
     589  Ye: TColor32Entry absolute C2;
     590  R: TColor32Entry absolute Result;
     591  Temp: SmallInt;
     592begin
     593  Temp := Xe.A - Ye.A;
     594  if Temp < 0 then
     595    R.A := 0
     596  else
     597    R.A := Temp;
     598  Temp := Xe.R - Ye.R;
     599  if Temp < 0 then
     600    R.R := 0
     601  else
     602    R.R := Temp;
     603  Temp := Xe.G - Ye.G;
     604  if Temp < 0 then
     605    R.G := 0
     606  else
     607    R.G := Temp;
     608  Temp := Xe.B - Ye.B;
     609  if Temp < 0 then
     610    R.B := 0
     611  else
     612    R.B := Temp;
    527613end;
    528614
    529615function ColorDiv_Pas(C1, C2: TColor32): TColor32;
    530616var
    531   r1, g1, b1, a1: Integer;
    532   r2, g2, b2, a2: Integer;
    533 begin
    534   a1 := C1 shr 24;
    535   r1 := (C1 and $00FF0000) shr 16;
    536   g1 := (C1 and $0000FF00) shr 8;
    537   b1 := C1 and $000000FF;
    538 
    539   a2 := C2 shr 24;
    540   r2 := (C2 and $00FF0000) shr 16;
    541   g2 := (C2 and $0000FF00) shr 8;
    542   b2 := C2 and $000000FF;
    543 
    544   if a1 = 0 then a1:=$FF
    545   else a1 := (a2 shl 8) div a1;
    546   if r1 = 0 then r1:=$FF
    547   else r1 := (r2 shl 8) div r1;
    548   if g1 = 0 then g1:=$FF
    549   else g1 := (g2 shl 8) div g1;
    550   if b1 = 0 then b1:=$FF
    551   else b1 := (b2 shl 8) div b1;
    552 
    553   if a1 > $FF then a1 := $FF;
    554   if r1 > $FF then r1 := $FF;
    555   if g1 > $FF then g1 := $FF;
    556   if b1 > $FF then b1 := $FF;
    557 
    558   Result := a1 shl 24 + r1 shl 16 + g1 shl 8 + b1;
     617  C1e: TColor32Entry absolute C1;
     618  C2e: TColor32Entry absolute C2;
     619  Re: TColor32Entry absolute Result;
     620  Temp: Word;
     621begin
     622  if C1e.A = 0 then
     623    Re.A := $FF
     624  else
     625  begin
     626    Temp := (C2e.A shl 8) div C1e.A;
     627    if Temp > $FF then
     628      Re.A := $FF
     629    else
     630      Re.A := Temp;
     631  end;
     632
     633  if C1e.R = 0 then
     634    Re.R := $FF
     635  else
     636  begin
     637    Temp := (C2e.R shl 8) div C1e.R;
     638    if Temp > $FF then
     639      Re.R := $FF
     640    else
     641      Re.R := Temp;
     642  end;
     643
     644  if C1e.G = 0 then
     645    Re.G := $FF
     646  else
     647  begin
     648    Temp := (C2e.G shl 8) div C1e.G;
     649    if Temp > $FF then
     650      Re.G := $FF
     651    else
     652      Re.G := Temp;
     653  end;
     654
     655  if C1e.B = 0 then
     656    Re.B := $FF
     657  else
     658  begin
     659    Temp := (C2e.B shl 8) div C1e.B;
     660    if Temp > $FF then
     661      Re.B := $FF
     662    else
     663      Re.B := Temp;
     664  end;
    559665end;
    560666
    561667function ColorModulate_Pas(C1, C2: TColor32): TColor32;
    562668var
    563   REnt: TColor32Entry absolute Result;
    564   C2Ent: TColor32Entry absolute C2;
    565 begin
    566   Result := C1;
    567   REnt.A := (C2Ent.A * REnt.A) shr 8;
    568   REnt.R := (C2Ent.R * REnt.R) shr 8;
    569   REnt.G := (C2Ent.G * REnt.G) shr 8;
    570   REnt.B := (C2Ent.B * REnt.B) shr 8;
     669  C1e: TColor32Entry absolute C2;
     670  C2e: TColor32Entry absolute C2;
     671  Re: TColor32Entry absolute Result;
     672begin
     673  Re.A := (C2e.A * C1e.A + $80) shr 8;
     674  Re.R := (C2e.R * C1e.R + $80) shr 8;
     675  Re.G := (C2e.G * C1e.G + $80) shr 8;
     676  Re.B := (C2e.B * C1e.B + $80) shr 8;
    571677end;
    572678
     
    603709function ColorDifference_Pas(C1, C2: TColor32): TColor32;
    604710var
    605   r1, g1, b1, a1: TColor32;
    606   r2, g2, b2, a2: TColor32;
    607 begin
    608   a1 := C1 shr 24;
    609   r1 := C1 and $00FF0000;
    610   g1 := C1 and $0000FF00;
    611   b1 := C1 and $000000FF;
    612 
    613   r1 := r1 shr 16;
    614   g1 := g1 shr 8;
    615 
    616   a2 := C2 shr 24;
    617   r2 := C2 and $00FF0000;
    618   g2 := C2 and $0000FF00;
    619   b2 := C2 and $000000FF;
    620 
    621   r2 := r2 shr 16;
    622   g2 := g2 shr 8;
    623 
    624   a1 := abs(a2 - a1);
    625   r1 := abs(r2 - r1);
    626   g1 := abs(g2 - g1);
    627   b1 := abs(b2 - b1);
    628 
    629   Result := a1 shl 24 + r1 shl 16 + g1 shl 8 + b1;
     711  Xe: TColor32Entry absolute C1;
     712  Ye: TColor32Entry absolute C2;
     713  R: TColor32Entry absolute Result;
     714begin
     715  R.A := Abs(Xe.A - Ye.A);
     716  R.R := Abs(Xe.R - Ye.R);
     717  R.G := Abs(Xe.G - Ye.G);
     718  R.B := Abs(Xe.B - Ye.B);
    630719end;
    631720
    632721function ColorExclusion_Pas(C1, C2: TColor32): TColor32;
    633722var
    634   r1, g1, b1, a1: TColor32;
    635   r2, g2, b2, a2: TColor32;
    636 begin
    637   a1 := C1 shr 24;
    638   r1 := C1 and $00FF0000;
    639   g1 := C1 and $0000FF00;
    640   b1 := C1 and $000000FF;
    641 
    642   r1 := r1 shr 16;
    643   g1 := g1 shr 8;
    644 
    645   a2 := C2 shr 24;
    646   r2 := C2 and $00FF0000;
    647   g2 := C2 and $0000FF00;
    648   b2 := C2 and $000000FF;
    649 
    650   r2 := r2 shr 16;
    651   g2 := g2 shr 8;
    652 
    653   a1 := a1 + a2 - (a1 * a2 shr 7);
    654   r1 := r1 + r2 - (r1 * r2 shr 7);
    655   g1 := g1 + g2 - (g1 * g2 shr 7);
    656   b1 := b1 + b2 - (b1 * b2 shr 7);
    657 
    658   Result := a1 shl 24 + r1 shl 16 + g1 shl 8 + b1;
     723  Xe: TColor32Entry absolute C1;
     724  Ye: TColor32Entry absolute C2;
     725  R: TColor32Entry absolute Result;
     726begin
     727  R.A := Xe.A + Ye.A - ((Xe.A * Ye.A) shl 7);
     728  R.R := Xe.R + Ye.R - ((Xe.R * Ye.R) shr 7);
     729  R.G := Xe.G + Ye.G - ((Xe.G * Ye.G) shr 7);
     730  R.B := Xe.B + Ye.B - ((Xe.B * Ye.B) shr 7);
    659731end;
    660732
     
    674746function ColorScale_Pas(C, W: TColor32): TColor32;
    675747var
     748  Ce: TColor32Entry absolute C;
     749var
    676750  r1, g1, b1, a1: Cardinal;
    677751begin
    678   a1 := C shr 24;
    679   r1 := C and $00FF0000;
    680   g1 := C and $0000FF00;
    681   b1 := C and $000000FF;
    682 
    683   r1 := r1 shr 16;
    684   g1 := g1 shr 8;
    685 
    686   a1 := a1 * W shr 8;
    687   r1 := r1 * W shr 8;
    688   g1 := g1 * W shr 8;
    689   b1 := b1 * W shr 8;
     752  a1 := Ce.A * W shr 8;
     753  r1 := Ce.R * W shr 8;
     754  g1 := Ce.G * W shr 8;
     755  b1 := Ce.B * W shr 8;
    690756
    691757  if a1 > 255 then a1 := 255;
     
    697763end;
    698764
     765function ColorScreen_Pas(B, S: TColor32): TColor32;
     766var
     767  Be: TColor32Entry absolute B;
     768  Se: TColor32Entry absolute S;
     769  R: TColor32Entry absolute Result;
     770begin
     771  R.A := Be.A + Se.A - (Be.A * Se.A) div 255;
     772  R.R := Be.R + Se.R - (Be.R * Se.R) div 255;
     773  R.G := Be.G + Se.G - (Be.G * Se.G) div 255;
     774  R.B := Be.B + Se.B - (Be.B * Se.B) div 255;
     775end;
     776
     777function ColorDodge_Pas(B, S: TColor32): TColor32;
     778
     779  function Dodge(B, S: Byte): Byte;
     780  begin
     781    if B = 0 then
     782      Result := 0
     783    else
     784    if S = 255 then
     785      Result := 255
     786    else
     787      Result := Clamp((255 * B) div (255 - S), 255);
     788  end;
     789
     790var
     791  Be: TColor32Entry absolute B;
     792  Se: TColor32Entry absolute S;
     793  R: TColor32Entry absolute Result;
     794begin
     795  R.A := Dodge(Be.A, Se.A);
     796  R.R := Dodge(Be.R, Se.R);
     797  R.G := Dodge(Be.G, Se.G);
     798  R.B := Dodge(Be.B, Se.B);
     799end;
     800
     801function ColorBurn_Pas(B, S: TColor32): TColor32;
     802
     803  function Burn(B, S: Byte): Byte;
     804  begin
     805    if B = 255 then
     806      Result := 255
     807    else
     808    if S = 0 then
     809      Result := 0
     810    else
     811      Result := 255 - Clamp(255 * (255 - B) div S, 255);
     812  end;
     813
     814var
     815  Be: TColor32Entry absolute B;
     816  Se: TColor32Entry absolute S;
     817  R: TColor32Entry absolute Result;
     818begin
     819  R.A := Burn(Be.A, Se.A);
     820  R.R := Burn(Be.R, Se.R);
     821  R.G := Burn(Be.G, Se.G);
     822  R.B := Burn(Be.B, Se.B);
     823end;
     824
     825
     826{ Blended color algebra }
     827
     828function BlendColorAdd_Pas(C1, C2: TColor32): TColor32;
     829var
     830  Xe: TColor32Entry absolute C1;
     831  Ye: TColor32Entry absolute C2;
     832  R: TColor32Entry absolute Result;
     833  Af, Ab: PByteArray;
     834begin
     835  Af := @DivTable[Xe.A];
     836  Ab := @DivTable[not Xe.A];
     837  R.A := Af[Clamp(Xe.A + Ye.A, 255)] + Ab[Ye.A];
     838  R.R := Af[Clamp(Xe.R + Ye.R, 255)] + Ab[Ye.R];
     839  R.G := Af[Clamp(Xe.G + Ye.G, 255)] + Ab[Ye.G];
     840  R.B := Af[Clamp(Xe.B + Ye.B, 255)] + Ab[Ye.B];
     841end;
     842
     843function BlendColorModulate_Pas(C1, C2: TColor32): TColor32;
     844var
     845  C1e: TColor32Entry absolute C1;
     846  C2e: TColor32Entry absolute C2;
     847  R: TColor32Entry absolute Result;
     848  Af, Ab: PByteArray;
     849begin
     850  Af := @DivTable[C1e.A];
     851  Ab := @DivTable[not C1e.A];
     852  R.A := Af[(C2e.A * C1e.A + $80) shr 8] + Ab[C2e.A];
     853  R.R := Af[(C2e.R * C1e.R + $80) shr 8] + Ab[C2e.R];
     854  R.G := Af[(C2e.G * C1e.G + $80) shr 8] + Ab[C2e.G];
     855  R.B := Af[(C2e.B * C1e.B + $80) shr 8] + Ab[C2e.B];
     856end;
     857
    699858{$IFNDEF PUREPASCAL}
    700 
    701 { Assembler versions }
    702 
    703 const
    704   bias = $00800080;
    705 
    706 
    707 function BlendReg_ASM(F, B: TColor32): TColor32;
    708 asm
    709   // blend foreground color (F) to a background color (B),
    710   // using alpha channel value of F
    711   // Result Z = Fa * Frgb + (1 - Fa) * Brgb
    712 
    713 {$IFDEF TARGET_x86}
    714   // EAX <- F
    715   // EDX <- B
    716 
    717 // Test Fa = 255 ?
    718         CMP     EAX,$FF000000   // Fa = 255 ? => Result = EAX
    719         JNC     @2
    720 
    721   // Test Fa = 0 ?
    722         TEST    EAX,$FF000000   // Fa = 0 ?   => Result = EDX
    723         JZ      @1
    724 
    725   // Get weight W = Fa * M
    726         MOV     ECX,EAX         // ECX  <-  Fa Fr Fg Fb
    727         SHR     ECX,24          // ECX  <-  00 00 00 Fa
    728 
    729         PUSH    EBX
    730 
    731   // P = W * F
    732         MOV     EBX,EAX         // EBX  <-  Fa Fr Fg Fb
    733         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    734         AND     EBX,$FF00FF00   // EBX  <-  Fa 00 Fg 00
    735         IMUL    EAX,ECX         // EAX  <-  Pr ** Pb **
    736         SHR     EBX,8           // EBX  <-  00 Fa 00 Fg
    737         IMUL    EBX,ECX         // EBX  <-  Pa ** Pg **
    738         ADD     EAX,bias
    739         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    740         SHR     EAX,8           // EAX  <-  00 Pr ** Pb
    741         ADD     EBX,bias
    742         AND     EBX,$FF00FF00   // EBX  <-  Pa 00 Pg 00
    743         OR      EAX,EBX         // EAX  <-  Pa Pr Pg Pb
    744 
    745   // W = 1 - W; Q = W * B
    746         XOR     ECX,$000000FF   // ECX  <-  1 - ECX
    747         MOV     EBX,EDX         // EBX  <-  Ba Br Bg Bb
    748         AND     EDX,$00FF00FF   // EDX  <-  00 Br 00 Bb
    749         AND     EBX,$FF00FF00   // EBX  <-  Ba 00 Bg 00
    750         IMUL    EDX,ECX         // EDX  <-  Qr ** Qb **
    751         SHR     EBX,8           // EBX  <-  00 Ba 00 Bg
    752         IMUL    EBX,ECX         // EBX  <-  Qa ** Qg **
    753         ADD     EDX,bias
    754         AND     EDX,$FF00FF00   // EDX  <-  Qr 00 Qb 00
    755         SHR     EDX,8           // EDX  <-  00 Qr ** Qb
    756         ADD     EBX,bias
    757         AND     EBX,$FF00FF00   // EBX  <-  Qa 00 Qg 00
    758         OR      EBX,EDX         // EBX  <-  Qa Qr Qg Qb
    759 
    760   // Z = P + Q (assuming no overflow at each byte)
    761         ADD     EAX,EBX         // EAX  <-  Za Zr Zg Zb
    762 
    763         POP     EBX
    764 {$IFDEF FPC}
    765         JMP @2
    766 {$ELSE}
    767         RET
    768 {$ENDIF}
    769 
    770 @1:     MOV     EAX,EDX
    771 @2:
    772 {$ENDIF}
    773 
    774   // EAX <- F
    775   // EDX <- B
    776 {$IFDEF TARGET_x64}
    777         MOV     RAX, RCX
    778 
    779   // Test Fa = 255 ?
    780         CMP     EAX,$FF000000   // Fa = 255 ? => Result = EAX
    781         JNC     @2
    782 
    783   // Test Fa = 0 ?
    784         TEST    EAX,$FF000000   // Fa = 0 ?   => Result = EDX
    785         JZ      @1
    786 
    787   // Get weight W = Fa * M
    788         MOV     ECX,EAX         // ECX  <-  Fa Fr Fg Fb
    789         SHR     ECX,24          // ECX  <-  00 00 00 Fa
    790 
    791   // P = W * F
    792         MOV     R9D,EAX         // R9D  <-  Fa Fr Fg Fb
    793         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    794         AND     R9D,$FF00FF00   // R9D  <-  Fa 00 Fg 00
    795         IMUL    EAX,ECX         // EAX  <-  Pr ** Pb **
    796         SHR     R9D,8           // R9D  <-  00 Fa 00 Fg
    797         IMUL    R9D,ECX         // R9D  <-  Pa ** Pg **
    798         ADD     EAX,bias
    799         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    800         SHR     EAX,8           // EAX  <-  00 Pr ** Pb
    801         ADD     R9D,bias
    802         AND     R9D,$FF00FF00   // R9D  <-  Pa 00 Pg 00
    803         OR      EAX,R9D         // EAX  <-  Pa Pr Pg Pb
    804 
    805   // W = 1 - W; Q = W * B
    806         XOR     ECX,$000000FF   // ECX  <-  1 - ECX
    807         MOV     R9D,EDX         // R9D  <-  Ba Br Bg Bb
    808         AND     EDX,$00FF00FF   // EDX  <-  00 Br 00 Bb
    809         AND     R9D,$FF00FF00   // R9D  <-  Ba 00 Bg 00
    810         IMUL    EDX,ECX         // EDX  <-  Qr ** Qb **
    811         SHR     R9D,8           // R9D  <-  00 Ba 00 Bg
    812         IMUL    R9D,ECX         // R9D  <-  Qa ** Qg **
    813         ADD     EDX,bias
    814         AND     EDX,$FF00FF00   // EDX  <-  Qr 00 Qb 00
    815         SHR     EDX,8           // EDX  <-  00 Qr ** Qb
    816         ADD     R9D,bias
    817         AND     R9D,$FF00FF00   // R9D  <-  Qa 00 Qg 00
    818         OR      R9D,EDX         // R9D  <-  Qa Qr Qg Qb
    819 
    820   // Z = P + Q (assuming no overflow at each byte)
    821         ADD     EAX,R9D         // EAX  <-  Za Zr Zg Zb
    822 {$IFDEF FPC}
    823         JMP @2
    824 {$ELSE}
    825         RET
    826 {$ENDIF}
    827 
    828 @1:     MOV     EAX,EDX
    829 @2:
    830 {$ENDIF}
    831 end;
    832 
    833 procedure BlendMem_ASM(F: TColor32; var B: TColor32);
    834 asm
    835 {$IFDEF TARGET_x86}
    836   // EAX <- F
    837   // [EDX] <- B
    838 
    839   // Test Fa = 0 ?
    840         TEST    EAX,$FF000000   // Fa = 0 ?   => do not write
    841         JZ      @2
    842 
    843   // Get weight W = Fa * M
    844         MOV     ECX,EAX         // ECX  <-  Fa Fr Fg Fb
    845         SHR     ECX,24          // ECX  <-  00 00 00 Fa
    846 
    847   // Test Fa = 255 ?
    848         CMP     ECX,$FF
    849         JZ      @1
    850 
    851         PUSH    EBX
    852         PUSH    ESI
    853 
    854   // P = W * F
    855         MOV     EBX,EAX         // EBX  <-  Fa Fr Fg Fb
    856         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    857         AND     EBX,$FF00FF00   // EBX  <-  Fa 00 Fg 00
    858         IMUL    EAX,ECX         // EAX  <-  Pr ** Pb **
    859         SHR     EBX,8           // EBX  <-  00 Fa 00 Fg
    860         IMUL    EBX,ECX         // EBX  <-  Pa ** Pg **
    861         ADD     EAX,bias
    862         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    863         SHR     EAX,8           // EAX  <-  00 Pr ** Pb
    864         ADD     EBX,bias
    865         AND     EBX,$FF00FF00   // EBX  <-  Pa 00 Pg 00
    866         OR      EAX,EBX         // EAX  <-  Pa Pr Pg Pb
    867 
    868         MOV     ESI,[EDX]
    869 
    870 // W = 1 - W; Q = W * B
    871         XOR     ECX,$000000FF   // ECX  <-  1 - ECX
    872         MOV     EBX,ESI         // EBX  <-  Ba Br Bg Bb
    873         AND     ESI,$00FF00FF   // ESI  <-  00 Br 00 Bb
    874         AND     EBX,$FF00FF00   // EBX  <-  Ba 00 Bg 00
    875         IMUL    ESI,ECX         // ESI  <-  Qr ** Qb **
    876         SHR     EBX,8           // EBX  <-  00 Ba 00 Bg
    877         IMUL    EBX,ECX         // EBX  <-  Qa ** Qg **
    878         ADD     ESI,bias
    879         AND     ESI,$FF00FF00   // ESI  <-  Qr 00 Qb 00
    880         SHR     ESI,8           // ESI  <-  00 Qr ** Qb
    881         ADD     EBX,bias
    882         AND     EBX,$FF00FF00   // EBX  <-  Qa 00 Qg 00
    883         OR      EBX,ESI         // EBX  <-  Qa Qr Qg Qb
    884 
    885   // Z = P + Q (assuming no overflow at each byte)
    886         ADD     EAX,EBX         // EAX  <-  Za Zr Zg Zb
    887 
    888         MOV     [EDX],EAX
    889         POP     ESI
    890         POP     EBX
    891 {$IFDEF FPC}
    892         JMP @2
    893 {$ELSE}
    894         RET
    895 {$ENDIF}
    896 
    897 @1:     MOV     [EDX],EAX
    898 @2:
    899 {$ENDIF}
    900 
    901 {$IFDEF TARGET_x64}
    902   // ECX <- F
    903   // [RDX] <- B
    904 
    905   // Test Fa = 0 ?
    906         TEST    ECX,$FF000000   // Fa = 0 ?   => do not write
    907         JZ      @2
    908 
    909         MOV     EAX, ECX        // EAX  <-  Fa Fr Fg Fb
    910 
    911         // Get weight W = Fa * M
    912         SHR     ECX,24          // ECX  <-  00 00 00 Fa
    913 
    914         // Test Fa = 255 ?
    915         CMP     ECX,$FF
    916         JZ      @1
    917 
    918   // P = W * F
    919         MOV     R8D,EAX         // R8D  <-  Fa Fr Fg Fb
    920         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    921         AND     R8D,$FF00FF00   // R8D  <-  Fa 00 Fg 00
    922         IMUL    EAX,ECX         // EAX  <-  Pr ** Pb **
    923         SHR     R8D,8           // R8D  <-  00 Fa 00 Fg
    924         IMUL    R8D,ECX         // R8D  <-  Pa ** Pg **
    925         ADD     EAX,bias
    926         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    927         SHR     EAX,8           // EAX  <-  00 Pr ** Pb
    928         ADD     R8D,bias
    929         AND     R8D,$FF00FF00   // R8D  <-  Pa 00 Pg 00
    930         OR      EAX,R8D         // EAX  <-  Pa Pr Pg Pb
    931 
    932         MOV     R9D,[RDX]
    933 
    934   // W = 1 - W; Q = W * B
    935         XOR     ECX,$000000FF   // ECX  <-  1 - ECX
    936         MOV     R8D,R9D         // R8D  <-  Ba Br Bg Bb
    937         AND     R9D,$00FF00FF   // R9D  <-  00 Br 00 Bb
    938         AND     R8D,$FF00FF00   // R8D  <-  Ba 00 Bg 00
    939         IMUL    R9D,ECX         // R9D  <-  Qr ** Qb **
    940         SHR     R8D,8           // R8D  <-  00 Ba 00 Bg
    941         IMUL    R8D,ECX         // R8D  <-  Qa ** Qg **
    942         ADD     R9D,bias
    943         AND     R9D,$FF00FF00   // R9D  <-  Qr 00 Qb 00
    944         SHR     R9D,8           // R9D  <-  00 Qr ** Qb
    945         ADD     R8D,bias
    946         AND     R8D,$FF00FF00   // R8D  <-  Qa 00 Qg 00
    947         OR      R8D,R9D         // R8D  <-  Qa Qr Qg Qb
    948 
    949   // Z = P + Q (assuming no overflow at each byte)
    950         ADD     EAX,R8D         // EAX  <-  Za Zr Zg Zb
    951 
    952         MOV     [RDX],EAX
    953 {$IFDEF FPC}
    954         JMP @2
    955 {$ELSE}
    956         RET
    957 {$ENDIF}
    958 
    959 @1:     MOV     [RDX],EAX
    960 @2:
    961 {$ENDIF}
    962 end;
    963 
    964 function BlendRegEx_ASM(F, B, M: TColor32): TColor32;
    965 asm
    966   // blend foreground color (F) to a background color (B),
    967   // using alpha channel value of F multiplied by master alpha (M)
    968   // no checking for M = $FF, in this case Graphics32 uses BlendReg
    969   // Result Z = Fa * M * Frgb + (1 - Fa * M) * Brgb
    970   // EAX <- F
    971   // EDX <- B
    972   // ECX <- M
    973 
    974 {$IFDEF TARGET_x86}
    975 
    976 // Check Fa > 0 ?
    977         TEST    EAX,$FF000000   // Fa = 0? => Result := EDX
    978         JZ      @2
    979 
    980         PUSH    EBX
    981 
    982   // Get weight W = Fa * M
    983         MOV     EBX,EAX         // EBX  <-  Fa Fr Fg Fb
    984         INC     ECX             // 255:256 range bias
    985         SHR     EBX,24          // EBX  <-  00 00 00 Fa
    986         IMUL    ECX,EBX         // ECX  <-  00 00  W **
    987         SHR     ECX,8           // ECX  <-  00 00 00  W
    988         JZ      @1              // W = 0 ?  => Result := EDX
    989 
    990   // P = W * F
    991         MOV     EBX,EAX         // EBX  <-  ** Fr Fg Fb
    992         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    993         AND     EBX,$0000FF00   // EBX  <-  00 00 Fg 00
    994         IMUL    EAX,ECX         // EAX  <-  Pr ** Pb **
    995         SHR     EBX,8           // EBX  <-  00 00 00 Fg
    996         IMUL    EBX,ECX         // EBX  <-  00 00 Pg **
    997         ADD     EAX,bias
    998         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    999         SHR     EAX,8           // EAX  <-  00 Pr ** Pb
    1000         ADD     EBX,bias
    1001         AND     EBX,$0000FF00   // EBX  <-  00 00 Pg 00
    1002         OR      EAX,EBX         // EAX  <-  00 Pr Pg Pb
    1003 
    1004   // W = 1 - W; Q = W * B
    1005         XOR     ECX,$000000FF   // ECX  <-  1 - ECX
    1006         MOV     EBX,EDX         // EBX  <-  00 Br Bg Bb
    1007         AND     EDX,$00FF00FF   // EDX  <-  00 Br 00 Bb
    1008         AND     EBX,$0000FF00   // EBX  <-  00 00 Bg 00
    1009         IMUL    EDX,ECX         // EDX  <-  Qr ** Qb **
    1010         SHR     EBX,8           // EBX  <-  00 00 00 Bg
    1011         IMUL    EBX,ECX         // EBX  <-  00 00 Qg **
    1012         ADD     EDX,bias
    1013         AND     EDX,$FF00FF00   // EDX  <-  Qr 00 Qb 00
    1014         SHR     EDX,8           // EDX  <-  00 Qr ** Qb
    1015         ADD     EBX,bias
    1016         AND     EBX,$0000FF00   // EBX  <-  00 00 Qg 00
    1017         OR      EBX,EDX         // EBX  <-  00 Qr Qg Qb
    1018 
    1019   // Z = P + Q (assuming no overflow at each byte)
    1020         ADD     EAX,EBX         // EAX  <-  00 Zr Zg Zb
    1021 
    1022         POP     EBX
    1023 {$IFDEF FPC}
    1024         JMP @3
    1025 {$ELSE}
    1026         RET
    1027 {$ENDIF}
    1028 
    1029 @1:
    1030         POP     EBX
    1031 
    1032 @2:     MOV     EAX,EDX
    1033 @3:
    1034 {$ENDIF}
    1035 
    1036 {$IFDEF TARGET_x64}
    1037         MOV     EAX,ECX         // EAX  <-  Fa Fr Fg Fb
    1038         TEST    EAX,$FF000000   // Fa = 0? => Result := EDX
    1039         JZ      @1
    1040 
    1041   // Get weight W = Fa * M
    1042         INC     R8D             // 255:256 range bias
    1043         SHR     ECX,24          // ECX  <-  00 00 00 Fa
    1044         IMUL    R8D,ECX         // R8D  <-  00 00  W **
    1045         SHR     R8D,8           // R8D  <-  00 00 00  W
    1046         JZ      @1              // W = 0 ?  => Result := EDX
    1047 
    1048   // P = W * F
    1049         MOV     ECX,EAX         // ECX  <-  ** Fr Fg Fb
    1050         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    1051         AND     ECX,$0000FF00   // ECX  <-  00 00 Fg 00
    1052         IMUL    EAX,R8D         // EAX  <-  Pr ** Pb **
    1053         SHR     ECX,8           // ECX  <-  00 00 00 Fg
    1054         IMUL    ECX,R8D         // ECX  <-  00 00 Pg **
    1055         ADD     EAX,bias
    1056         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    1057         SHR     EAX,8           // EAX  <-  00 Pr ** Pb
    1058         ADD     ECX,bias
    1059         AND     ECX,$0000FF00   // ECX  <-  00 00 Pg 00
    1060         OR      EAX,ECX         // EAX  <-  00 Pr Pg Pb
    1061 
    1062   // W = 1 - W; Q = W * B
    1063         XOR     R8D,$000000FF   // R8D  <-  1 - R8D
    1064         MOV     ECX,EDX         // ECX  <-  00 Br Bg Bb
    1065         AND     EDX,$00FF00FF   // EDX  <-  00 Br 00 Bb
    1066         AND     ECX,$0000FF00   // ECX  <-  00 00 Bg 00
    1067         IMUL    EDX,R8D         // EDX  <-  Qr ** Qb **
    1068         SHR     ECX,8           // ECX  <-  00 00 00 Bg
    1069         IMUL    ECX,R8D         // ECX  <-  00 00 Qg **
    1070         ADD     EDX,bias
    1071         AND     EDX,$FF00FF00   // EDX  <-  Qr 00 Qb 00
    1072         SHR     EDX,8           // EDX  <-  00 Qr ** Qb
    1073         ADD     ECX,bias
    1074         AND     ECX,$0000FF00   // ECX  <-  00 00 Qg 00
    1075         OR      ECX,EDX         // ECX  <-  00 Qr Qg Qb
    1076 
    1077   // Z = P + Q (assuming no overflow at each byte)
    1078         ADD     EAX,ECX         // EAX  <-  00 Zr Zg Zb
    1079 
    1080 {$IFDEF FPC}
    1081         JMP @2
    1082 {$ELSE}
    1083         RET
    1084 {$ENDIF}
    1085 
    1086 @1:     MOV     EAX,EDX
    1087 @2:
    1088 {$ENDIF}
    1089 end;
    1090 
    1091 procedure BlendMemEx_ASM(F: TColor32; var B: TColor32; M: TColor32);
    1092 asm
    1093 {$IFDEF TARGET_x86}
    1094   // EAX <- F
    1095   // [EDX] <- B
    1096   // ECX <- M
    1097 
    1098   // Check Fa > 0 ?
    1099         TEST    EAX,$FF000000   // Fa = 0? => write nothing
    1100         JZ      @2
    1101 
    1102         PUSH    EBX
    1103 
    1104   // Get weight W = Fa * M
    1105         MOV     EBX,EAX         // EBX  <-  Fa Fr Fg Fb
    1106         INC     ECX             // 255:256 range bias
    1107         SHR     EBX,24          // EBX  <-  00 00 00 Fa
    1108         IMUL    ECX,EBX         // ECX  <-  00 00  W **
    1109         SHR     ECX,8           // ECX  <-  00 00 00  W
    1110         JZ      @1              // W = 0 ?  => write nothing
    1111 
    1112         PUSH    ESI
    1113 
    1114   // P = W * F
    1115         MOV     EBX,EAX         // EBX  <-  ** Fr Fg Fb
    1116         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    1117         AND     EBX,$0000FF00   // EBX  <-  00 00 Fg 00
    1118         IMUL    EAX,ECX         // EAX  <-  Pr ** Pb **
    1119         SHR     EBX,8           // EBX  <-  00 00 00 Fg
    1120         IMUL    EBX,ECX         // EBX  <-  00 00 Pg **
    1121         ADD     EAX,bias
    1122         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    1123         SHR     EAX,8           // EAX  <-  00 Pr ** Pb
    1124         ADD     EBX,bias
    1125         AND     EBX,$0000FF00   // EBX  <-  00 00 Pg 00
    1126         OR      EAX,EBX         // EAX  <-  00 Pr Pg Pb
    1127 
    1128   // W = 1 - W; Q = W * B
    1129         MOV     ESI,[EDX]
    1130         XOR     ECX,$000000FF   // ECX  <-  1 - ECX
    1131         MOV     EBX,ESI         // EBX  <-  00 Br Bg Bb
    1132         AND     ESI,$00FF00FF   // ESI  <-  00 Br 00 Bb
    1133         AND     EBX,$0000FF00   // EBX  <-  00 00 Bg 00
    1134         IMUL    ESI,ECX         // ESI  <-  Qr ** Qb **
    1135         SHR     EBX,8           // EBX  <-  00 00 00 Bg
    1136         IMUL    EBX,ECX         // EBX  <-  00 00 Qg **
    1137         ADD     ESI,bias
    1138         AND     ESI,$FF00FF00   // ESI  <-  Qr 00 Qb 00
    1139         SHR     ESI,8           // ESI  <-  00 Qr ** Qb
    1140         ADD     EBX,bias
    1141         AND     EBX,$0000FF00   // EBX  <-  00 00 Qg 00
    1142         OR      EBX,ESI         // EBX  <-  00 Qr Qg Qb
    1143 
    1144   // Z = P + Q (assuming no overflow at each byte)
    1145         ADD     EAX,EBX         // EAX  <-  00 Zr Zg Zb
    1146 
    1147         MOV     [EDX],EAX
    1148         POP     ESI
    1149 
    1150 @1:     POP     EBX
    1151 @2:
    1152 {$ENDIF}
    1153 
    1154 {$IFDEF TARGET_x64}
    1155   // ECX <- F
    1156   // [RDX] <- B
    1157   // R8 <- M
    1158 
    1159   // ECX <- F
    1160   // [EDX] <- B
    1161   // R8 <- M
    1162 
    1163   // Check Fa > 0 ?
    1164         TEST    ECX,$FF000000   // Fa = 0? => write nothing
    1165         JZ      @1
    1166 
    1167   // Get weight W = Fa * M
    1168         MOV     EAX,ECX         // EAX  <-  Fa Fr Fg Fb
    1169         INC     R8D             // 255:256 range bias
    1170         SHR     EAX,24          // EAX  <-  00 00 00 Fa
    1171         IMUL    R8D,EAX         // R8D <-  00 00  W **
    1172         SHR     R8D,8           // R8D <-  00 00 00  W
    1173         JZ      @1              // W = 0 ?  => write nothing
    1174 
    1175   // P = W * F
    1176         MOV     EAX,ECX         // EAX  <-  ** Fr Fg Fb
    1177         AND     ECX,$00FF00FF   // ECX  <-  00 Fr 00 Fb
    1178         AND     EAX,$0000FF00   // EAX  <-  00 00 Fg 00
    1179         IMUL    ECX,R8D         // ECX  <-  Pr ** Pb **
    1180         SHR     EAX,8           // EAX  <-  00 00 00 Fg
    1181         IMUL    EAX,R8D         // EAX  <-  00 00 Pg **
    1182         ADD     ECX,bias
    1183         AND     ECX,$FF00FF00   // ECX  <-  Pr 00 Pb 00
    1184         SHR     ECX,8           // ECX  <-  00 Pr ** Pb
    1185         ADD     EAX,bias
    1186         AND     EAX,$0000FF00   // EAX  <-  00 00 Pg 00
    1187         OR      ECX,EAX         // ECX  <-  00 Pr Pg Pb
    1188 
    1189   // W = 1 - W; Q = W * B
    1190         MOV     R9D,[RDX]
    1191         XOR     R8D,$000000FF   // R8D  <-  1 - R8
    1192         MOV     EAX,R9D         // EAX  <-  00 Br Bg Bb
    1193         AND     R9D,$00FF00FF   // R9D  <-  00 Br 00 Bb
    1194         AND     EAX,$0000FF00   // EAX  <-  00 00 Bg 00
    1195         IMUL    R9D,R8D         // R9D  <-  Qr ** Qb **
    1196         SHR     EAX,8           // EAX  <-  00 00 00 Bg
    1197         IMUL    EAX,R8D         // EAX  <-  00 00 Qg **
    1198         ADD     R9D,bias
    1199         AND     R9D,$FF00FF00   // R9D  <-  Qr 00 Qb 00
    1200         SHR     R9D,8           // R9D  <-  00 Qr ** Qb
    1201         ADD     EAX,bias
    1202         AND     EAX,$0000FF00   // EAX  <-  00 00 Qg 00
    1203         OR      EAX,R9D         // EAX  <-  00 Qr Qg Qb
    1204 
    1205   // Z = P + Q (assuming no overflow at each byte)
    1206         ADD     ECX,EAX         // ECX  <-  00 Zr Zg Zb
    1207 
    1208         MOV     [RDX],ECX
    1209 
    1210 @1:
    1211 {$ENDIF}
    1212 end;
    1213 
    1214 procedure BlendLine_ASM(Src, Dst: PColor32; Count: Integer);
    1215 asm
    1216 {$IFDEF TARGET_x86}
    1217   // EAX <- Src
    1218   // EDX <- Dst
    1219   // ECX <- Count
    1220 
    1221   // test the counter for zero or negativity
    1222         TEST    ECX,ECX
    1223         JS      @4
    1224 
    1225         PUSH    EBX
    1226         PUSH    ESI
    1227         PUSH    EDI
    1228 
    1229         MOV     ESI,EAX         // ESI <- Src
    1230         MOV     EDI,EDX         // EDI <- Dst
    1231 
    1232   // loop start
    1233 @1:     MOV     EAX,[ESI]
    1234         TEST    EAX,$FF000000
    1235         JZ      @3              // complete transparency, proceed to next point
    1236 
    1237         PUSH    ECX             // store counter
    1238 
    1239   // Get weight W = Fa * M
    1240         MOV     ECX,EAX         // ECX  <-  Fa Fr Fg Fb
    1241         SHR     ECX,24          // ECX  <-  00 00 00 Fa
    1242 
    1243   // Test Fa = 255 ?
    1244         CMP     ECX,$FF
    1245         JZ      @2
    1246 
    1247   // P = W * F
    1248         MOV     EBX,EAX         // EBX  <-  Fa Fr Fg Fb
    1249         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    1250         AND     EBX,$FF00FF00   // EBX  <-  Fa 00 Fg 00
    1251         IMUL    EAX,ECX         // EAX  <-  Pr ** Pb **
    1252         SHR     EBX,8           // EBX  <-  00 Fa 00 Fg
    1253         IMUL    EBX,ECX         // EBX  <-  Pa ** Pg **
    1254         ADD     EAX,bias
    1255         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    1256         SHR     EAX,8           // EAX  <-  00 Pr ** Pb
    1257         ADD     EBX,bias
    1258         AND     EBX,$FF00FF00   // EBX  <-  Pa 00 Pg 00
    1259         OR      EAX,EBX         // EAX  <-  Pa Pr Pg Pb
    1260 
    1261   // W = 1 - W; Q = W * B
    1262         MOV     EDX,[EDI]
    1263         XOR     ECX,$000000FF   // ECX  <-  1 - ECX
    1264         MOV     EBX,EDX         // EBX  <-  Ba Br Bg Bb
    1265         AND     EDX,$00FF00FF   // ESI  <-  00 Br 00 Bb
    1266         AND     EBX,$FF00FF00   // EBX  <-  Ba 00 Bg 00
    1267         IMUL    EDX,ECX         // ESI  <-  Qr ** Qb **
    1268         SHR     EBX,8           // EBX  <-  00 Ba 00 Bg
    1269         IMUL    EBX,ECX         // EBX  <-  Qa ** Qg **
    1270         ADD     EDX,bias
    1271         AND     EDX,$FF00FF00   // ESI  <-  Qr 00 Qb 00
    1272         SHR     EDX,8           // ESI  <-  00 Qr ** Qb
    1273         ADD     EBX,bias
    1274         AND     EBX,$FF00FF00   // EBX  <-  Qa 00 Qg 00
    1275         OR      EBX,EDX         // EBX  <-  Qa Qr Qg Qb
    1276 
    1277   // Z = P + Q (assuming no overflow at each byte)
    1278         ADD     EAX,EBX         // EAX  <-  Za Zr Zg Zb
    1279 @2:
    1280         MOV     [EDI],EAX
    1281 
    1282         POP     ECX             // restore counter
    1283 
    1284 @3:
    1285         ADD     ESI,4
    1286         ADD     EDI,4
    1287 
    1288   // loop end
    1289         DEC     ECX
    1290         JNZ     @1
    1291 
    1292         POP     EDI
    1293         POP     ESI
    1294         POP     EBX
    1295 
    1296 @4:
    1297 {$ENDIF}
    1298 
    1299 {$IFDEF TARGET_x64}
    1300   // RCX <- Src
    1301   // RDX <- Dst
    1302   // R8 <- Count
    1303 
    1304   // test the counter for zero or negativity
    1305         TEST    R8D,R8D
    1306         JS      @4
    1307 
    1308         MOV     R10,RCX         // R10 <- Src
    1309         MOV     R11,RDX         // R11 <- Dst
    1310         MOV     ECX,R8D         // RCX <- Count
    1311 
    1312   // loop start
    1313 @1:
    1314         MOV     EAX,[R10]
    1315         TEST    EAX,$FF000000
    1316         JZ      @3              // complete transparency, proceed to next point
    1317 
    1318   // Get weight W = Fa * M
    1319         MOV     R9D,EAX        // R9D  <-  Fa Fr Fg Fb
    1320         SHR     R9D,24         // R9D  <-  00 00 00 Fa
    1321 
    1322   // Test Fa = 255 ?
    1323         CMP     R9D,$FF
    1324         JZ      @2
    1325 
    1326   // P = W * F
    1327         MOV     R8D,EAX         // R8D  <-  Fa Fr Fg Fb
    1328         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    1329         AND     R8D,$FF00FF00   // R8D  <-  Fa 00 Fg 00
    1330         IMUL    EAX,R9D         // EAX  <-  Pr ** Pb **
    1331         SHR     R8D,8           // R8D  <-  00 Fa 00 Fg
    1332         IMUL    R8D,R9D         // R8D  <-  Pa ** Pg **
    1333         ADD     EAX,bias
    1334         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    1335         SHR     EAX,8           // EAX  <-  00 Pr ** Pb
    1336         ADD     R8D,bias
    1337         AND     R8D,$FF00FF00   // R8D  <-  Pa 00 Pg 00
    1338         OR      EAX,R8D         // EAX  <-  Pa Pr Pg Pb
    1339 
    1340   // W = 1 - W; Q = W * B
    1341         MOV     EDX,[R11]
    1342         XOR     R9D,$000000FF   // R9D  <-  1 - R9D
    1343         MOV     R8D,EDX         // R8D  <-  Ba Br Bg Bb
    1344         AND     EDX,$00FF00FF   // ESI  <-  00 Br 00 Bb
    1345         AND     R8D,$FF00FF00   // R8D  <-  Ba 00 Bg 00
    1346         IMUL    EDX,R9D         // ESI  <-  Qr ** Qb **
    1347         SHR     R8D,8           // R8D  <-  00 Ba 00 Bg
    1348         IMUL    R8D,R9D         // R8D  <-  Qa ** Qg **
    1349         ADD     EDX,bias
    1350         AND     EDX,$FF00FF00   // ESI  <-  Qr 00 Qb 00
    1351         SHR     EDX,8           // ESI  <-  00 Qr ** Qb
    1352         ADD     R8D,bias
    1353         AND     R8D,$FF00FF00   // R8D  <-  Qa 00 Qg 00
    1354         OR      R8D,EDX         // R8D  <-  Qa Qr Qg Qb
    1355 
    1356   // Z = P + Q (assuming no overflow at each byte)
    1357         ADD     EAX,R8D         // EAX  <-  Za Zr Zg Zb
    1358 @2:
    1359         MOV     [R11],EAX
    1360 
    1361 @3:
    1362         ADD     R10,4
    1363         ADD     R11,4
    1364 
    1365   // loop end
    1366         DEC     ECX
    1367         JNZ     @1
    1368 
    1369 @4:
    1370 {$ENDIF}
    1371 end;
    1372 
    1373 {$IFDEF TARGET_x86}
    1374 
    1375 function MergeReg_ASM(F, B: TColor32): TColor32;
    1376 asm
    1377         // EAX <- F
    1378         // EDX <- B
    1379 
    1380         // if F.A = 0 then
    1381         TEST    EAX,$FF000000
    1382         JZ      @exit0
    1383 
    1384         // else if B.A = 255 then
    1385         CMP     EDX,$FF000000
    1386         JNC     @blend
    1387 
    1388         // else if F.A = 255 then
    1389         CMP     EAX,$FF000000
    1390         JNC     @Exit
    1391 
    1392         // else if B.A = 0 then
    1393         TEST    EDX,$FF000000
    1394         JZ      @Exit
    1395 
    1396 @4:
    1397         PUSH    EBX
    1398         PUSH    ESI
    1399         PUSH    EDI
    1400         ADD     ESP,-$0C
    1401         MOV     [ESP+$04],EDX
    1402         MOV     [ESP],EAX
    1403 
    1404         // AH <- F.A
    1405         // DL, CL <- B.A
    1406         SHR     EAX,16
    1407         AND     EAX,$0000FF00
    1408         SHR     EDX,24
    1409         MOV     CL,DL
    1410         NOP
    1411         NOP
    1412         NOP
    1413 
    1414         // EDI <- PF
    1415         // EDX <- PB
    1416         // ESI <- PR
    1417 
    1418         // PF := @DivTable[F.A];
    1419         LEA     EDI,[EAX+DivTable]
    1420         // PB := @DivTable[B.A];
    1421         SHL     EDX,$08
    1422         LEA     EDX,[EDX+DivTable]
    1423         // Result.A := B.A + F.A - PB[F.A];
    1424         SHR     EAX,8
    1425         //ADD CL,al
    1426         ADD     ECX,EAX
    1427         //SUB CL,[EDX+EAX]
    1428         SUB     ECX,[EDX+EAX]
    1429         MOV     [ESP+$0B],CL
    1430         // PR := @RcTable[Result.A];
    1431         SHL     ECX,$08
    1432         AND     ECX,$0000FFFF
    1433         LEA     ESI,[ECX+RcTable]
    1434 
    1435   { Red component }
    1436 
    1437         // Result.R := PB[B.R];
    1438         XOR     EAX,EAX
    1439         MOV     AL,[ESP+$06]
    1440         MOV     CL,[EDX+EAX]
    1441         MOV     [ESP+$0a],CL
    1442         // X := F.R - Result.R;
    1443         MOV     AL,[ESP+$02]
    1444         XOR     EBX,EBX
    1445         MOV     BL,CL
    1446         SUB     EAX,EBX
    1447         // if X >= 0 then
    1448         JL      @5
    1449         // Result.R := PR[PF[X] + Result.R]
    1450         MOVZX   EAX,BYTE PTR[EDI+EAX]
    1451         AND     ECX,$000000FF
    1452         ADD     EAX,ECX
    1453         MOV     AL,[ESI+EAX]
    1454         MOV     [ESP+$0a],al
    1455         JMP     @6
    1456 @5:
    1457         // Result.R := PR[Result.R - PF[-X]];
    1458         NEG     EAX
    1459         MOVZX   EAX,BYTE PTR[EDI+EAX]
    1460         XOR     ECX,ECX
    1461         MOV     CL,[ESP+$0A]
    1462         SUB     ECX,EAX
    1463         MOV     AL,[ESI+ECX]
    1464         MOV     [ESP+$0A],al
    1465 
    1466 
    1467   { Green component }
    1468 
    1469 @6:
    1470   // Result.G := PB[B.G];
    1471         XOR     EAX,EAX
    1472         MOV     AL,[ESP+$05]
    1473         MOV     CL,[EDX+EAX]
    1474         MOV     [ESP+$09],CL
    1475   // X := F.G - Result.G;
    1476         MOV     AL,[ESP+$01]
    1477         XOR     EBX,EBX
    1478         MOV     BL,CL
    1479         SUB     EAX,EBX
    1480   // if X >= 0 then
    1481         JL      @7
    1482   // Result.G := PR[PF[X] + Result.G]
    1483         MOVZX   EAX,BYTE PTR[EDI+EAX]
    1484         AND     ECX,$000000FF
    1485         ADD     EAX,ECX
    1486         MOV     AL,[ESI+EAX]
    1487         MOV     [ESP+$09],AL
    1488         JMP     @8
    1489 @7:
    1490   // Result.G := PR[Result.G - PF[-X]];
    1491         NEG     EAX
    1492         MOVZX   EAX,BYTE PTR[EDI+EAX]
    1493         XOR     ECX,ECX
    1494         MOV     CL,[ESP+$09]
    1495         SUB     ECX,EAX
    1496         MOV     AL,[ESI+ECX]
    1497         MOV     [ESP+$09],AL
    1498 
    1499 
    1500   { Blue component }
    1501 @8:
    1502   // Result.B := PB[B.B];
    1503         XOR     EAX,EAX
    1504         MOV     AL,[ESP+$04]
    1505         MOV     CL,[EDX+EAX]
    1506         MOV     [ESP+$08],CL
    1507   // X := F.B - Result.B;
    1508         MOV     AL,[ESP]
    1509         XOR     EDX,EDX
    1510         MOV     DL,CL
    1511         SUB     EAX,EDX
    1512   // if X >= 0 then
    1513         JL      @9
    1514   // Result.B := PR[PF[X] + Result.B]
    1515         MOVZX   EAX,BYTE PTR[EDI+EAX]
    1516         XOR     EDX,EDX
    1517         MOV     DL,CL
    1518         ADD     EAX,EDX
    1519         MOV     AL,[ESI+EAX]
    1520         MOV     [ESP+$08],al
    1521         JMP     @10
    1522 @9:
    1523   // Result.B := PR[Result.B - PF[-X]];
    1524         NEG     EAX
    1525         MOVZX   EAX,BYTE PTR[EDI+EAX]
    1526         XOR     EDX,EDX
    1527         MOV     DL,CL
    1528         SUB     EDX,EAX
    1529         MOV     AL,[ESI+EDX]
    1530         MOV     [ESP+$08],AL
    1531 
    1532 @10:
    1533   // EAX <- Result
    1534         MOV     EAX,[ESP+$08]
    1535 
    1536   // end;
    1537         ADD     ESP,$0C
    1538         POP     EDI
    1539         POP     ESI
    1540         POP     EBX
    1541 {$IFDEF FPC}
    1542         JMP @Exit
    1543 {$ELSE}
    1544         RET
    1545 {$ENDIF}
    1546 @blend:
    1547         CALL    DWORD PTR [BlendReg]
    1548         OR      EAX,$FF000000
    1549 {$IFDEF FPC}
    1550         JMP @Exit
    1551 {$ELSE}
    1552         RET
    1553 {$ENDIF}
    1554 @exit0:
    1555         MOV     EAX,EDX
    1556 @Exit:
    1557 end;
    1558 
    1559 {$ENDIF}
    1560 
    1561 function CombineReg_ASM(X, Y, W: TColor32): TColor32;
    1562 asm
    1563   // combine RGBA channels of colors X and Y with the weight of X given in W
    1564   // Result Z = W * X + (1 - W) * Y (all channels are combined, including alpha)
    1565 {$IFDEF TARGET_x86}
    1566   // EAX <- X
    1567   // EDX <- Y
    1568   // ECX <- W
    1569 
    1570   // W = 0 or $FF?
    1571         JCXZ    @1              // CX = 0 ?  => Result := EDX
    1572         CMP     ECX,$FF         // CX = $FF ?  => Result := EDX
    1573         JE      @2
    1574 
    1575         PUSH    EBX
    1576 
    1577   // P = W * X
    1578         MOV     EBX,EAX         // EBX  <-  Xa Xr Xg Xb
    1579         AND     EAX,$00FF00FF   // EAX  <-  00 Xr 00 Xb
    1580         AND     EBX,$FF00FF00   // EBX  <-  Xa 00 Xg 00
    1581         IMUL    EAX,ECX         // EAX  <-  Pr ** Pb **
    1582         SHR     EBX,8           // EBX  <-  00 Xa 00 Xg
    1583         IMUL    EBX,ECX         // EBX  <-  Pa ** Pg **
    1584         ADD     EAX,bias
    1585         AND     EAX,$FF00FF00   // EAX  <-  Pa 00 Pg 00
    1586         SHR     EAX,8           // EAX  <-  00 Pr 00 Pb
    1587         ADD     EBX,bias
    1588         AND     EBX,$FF00FF00   // EBX  <-  Pa 00 Pg 00
    1589         OR      EAX,EBX         // EAX  <-  Pa Pr Pg Pb
    1590 
    1591   // W = 1 - W; Q = W * Y
    1592         XOR     ECX,$000000FF   // ECX  <-  1 - ECX
    1593         MOV     EBX,EDX         // EBX  <-  Ya Yr Yg Yb
    1594         AND     EDX,$00FF00FF   // EDX  <-  00 Yr 00 Yb
    1595         AND     EBX,$FF00FF00   // EBX  <-  Ya 00 Yg 00
    1596         IMUL    EDX,ECX         // EDX  <-  Qr ** Qb **
    1597         SHR     EBX,8           // EBX  <-  00 Ya 00 Yg
    1598         IMUL    EBX,ECX         // EBX  <-  Qa ** Qg **
    1599         ADD     EDX,bias
    1600         AND     EDX,$FF00FF00   // EDX  <-  Qr 00 Qb 00
    1601         SHR     EDX,8           // EDX  <-  00 Qr ** Qb
    1602         ADD     EBX,bias
    1603         AND     EBX,$FF00FF00   // EBX  <-  Qa 00 Qg 00
    1604         OR      EBX,EDX         // EBX  <-  Qa Qr Qg Qb
    1605 
    1606   // Z = P + Q (assuming no overflow at each byte)
    1607         ADD     EAX,EBX         // EAX  <-  Za Zr Zg Zb
    1608 
    1609         POP     EBX
    1610 {$IFDEF FPC}
    1611         JMP @2
    1612 {$ELSE}
    1613         RET
    1614 {$ENDIF}
    1615 
    1616 @1:     MOV     EAX,EDX
    1617 @2:
    1618 {$ENDIF}
    1619 
    1620 {$IFDEF TARGET_x64}
    1621   // ECX <- X
    1622   // EDX <- Y
    1623   // R8D <- W
    1624 
    1625   // W = 0 or $FF?
    1626         TEST    R8D,R8D
    1627         JZ      @1              // W = 0 ?  => Result := EDX
    1628         MOV     EAX,ECX         // EAX  <-  Xa Xr Xg Xb
    1629         CMP     R8B,$FF         // W = $FF ?  => Result := EDX
    1630         JE      @2
    1631 
    1632   // P = W * X
    1633         AND     EAX,$00FF00FF   // EAX  <-  00 Xr 00 Xb
    1634         AND     ECX,$FF00FF00   // ECX  <-  Xa 00 Xg 00
    1635         IMUL    EAX,R8D         // EAX  <-  Pr ** Pb **
    1636         SHR     ECX,8           // ECX  <-  00 Xa 00 Xg
    1637         IMUL    ECX,R8D         // ECX  <-  Pa ** Pg **
    1638         ADD     EAX,bias
    1639         AND     EAX,$FF00FF00   // EAX  <-  Pa 00 Pg 00
    1640         SHR     EAX,8           // EAX  <-  00 Pr 00 Pb
    1641         ADD     ECX,bias
    1642         AND     ECX,$FF00FF00   // ECX  <-  Pa 00 Pg 00
    1643         OR      EAX,ECX         // EAX  <-  Pa Pr Pg Pb
    1644 
    1645   // W = 1 - W; Q = W * Y
    1646         XOR     R8D,$000000FF   // R8D  <-  1 - R8D
    1647         MOV     ECX,EDX         // ECX  <-  Ya Yr Yg Yb
    1648         AND     EDX,$00FF00FF   // EDX  <-  00 Yr 00 Yb
    1649         AND     ECX,$FF00FF00   // ECX  <-  Ya 00 Yg 00
    1650         IMUL    EDX,R8D         // EDX  <-  Qr ** Qb **
    1651         SHR     ECX,8           // ECX  <-  00 Ya 00 Yg
    1652         IMUL    ECX,R8D         // ECX  <-  Qa ** Qg **
    1653         ADD     EDX,bias
    1654         AND     EDX,$FF00FF00   // EDX  <-  Qr 00 Qb 00
    1655         SHR     EDX,8           // EDX  <-  00 Qr ** Qb
    1656         ADD     ECX,bias
    1657         AND     ECX,$FF00FF00   // ECX  <-  Qa 00 Qg 00
    1658         OR      ECX,EDX         // ECX  <-  Qa Qr Qg Qb
    1659 
    1660   // Z = P + Q (assuming no overflow at each byte)
    1661         ADD     EAX,ECX         // EAX  <-  Za Zr Zg Zb
    1662 
    1663 {$IFDEF FPC}
    1664         JMP @2
    1665 {$ELSE}
    1666         RET
    1667 {$ENDIF}
    1668 
    1669 @1:     MOV     EAX,EDX
    1670 @2:
    1671 {$ENDIF}
    1672 end;
    1673 
    1674 procedure CombineMem_ASM(X: TColor32; var Y: TColor32; W: TColor32);
    1675 asm
    1676 {$IFDEF TARGET_x86}
    1677   // EAX <- F
    1678   // [EDX] <- B
    1679   // ECX <- W
    1680 
    1681   // Check W
    1682         JCXZ    @1              // W = 0 ?  => write nothing
    1683         CMP     ECX,$FF         // W = 255? => write F
    1684 {$IFDEF FPC}
    1685         DB      $74,$76         //Prob with FPC 2.2.2 and below
    1686 {$ELSE}
    1687         JZ      @2
    1688 {$ENDIF}
    1689 
    1690 
    1691         PUSH    EBX
    1692         PUSH    ESI
    1693 
    1694   // P = W * F
    1695         MOV     EBX,EAX         // EBX  <-  ** Fr Fg Fb
    1696         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    1697         AND     EBX,$FF00FF00   // EBX  <-  Fa 00 Fg 00
    1698         IMUL    EAX,ECX         // EAX  <-  Pr ** Pb **
    1699         SHR     EBX,8           // EBX  <-  00 Fa 00 Fg
    1700         IMUL    EBX,ECX         // EBX  <-  00 00 Pg **
    1701         ADD     EAX,bias
    1702         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    1703         SHR     EAX,8           // EAX  <-  00 Pr 00 Pb
    1704         ADD     EBX,bias
    1705         AND     EBX,$FF00FF00   // EBX  <-  Pa 00 Pg 00
    1706         OR      EAX,EBX         // EAX  <-  00 Pr Pg Pb
    1707 
    1708   // W = 1 - W; Q = W * B
    1709         MOV     ESI,[EDX]
    1710         XOR     ECX,$000000FF   // ECX  <-  1 - ECX
    1711         MOV     EBX,ESI         // EBX  <-  Ba Br Bg Bb
    1712         AND     ESI,$00FF00FF   // ESI  <-  00 Br 00 Bb
    1713         AND     EBX,$FF00FF00   // EBX  <-  Ba 00 Bg 00
    1714         IMUL    ESI,ECX         // ESI  <-  Qr ** Qb **
    1715         SHR     EBX,8           // EBX  <-  00 Ba 00 Bg
    1716         IMUL    EBX,ECX         // EBX  <-  Qa 00 Qg **
    1717         ADD     ESI,bias
    1718         AND     ESI,$FF00FF00   // ESI  <-  Qr 00 Qb 00
    1719         SHR     ESI,8           // ESI  <-  00 Qr ** Qb
    1720         ADD     EBX,bias
    1721         AND     EBX,$FF00FF00   // EBX  <-  Qa 00 Qg 00
    1722         OR      EBX,ESI         // EBX  <-  00 Qr Qg Qb
    1723 
    1724   // Z = P + Q (assuming no overflow at each byte)
    1725         ADD     EAX,EBX         // EAX  <-  00 Zr Zg Zb
    1726 
    1727         MOV     [EDX],EAX
    1728 
    1729         POP     ESI
    1730         POP     EBX
    1731 {$IFDEF FPC}
    1732 @1:     JMP @3
    1733 {$ELSE}
    1734 @1:     RET
    1735 {$ENDIF}
    1736 
    1737 @2:     MOV     [EDX],EAX
    1738 @3:
    1739 {$ENDIF}
    1740 
    1741 {$IFDEF TARGET_x64}
    1742   // ECX <- F
    1743   // [RDX] <- B
    1744   // R8 <- W
    1745 
    1746   // Check W
    1747         TEST    R8D,R8D         // Set flags for R8
    1748         JZ      @2              // W = 0 ?  => Result := EDX
    1749         MOV     EAX,ECX         // EAX  <-  ** Fr Fg Fb
    1750         CMP     R8B,$FF         // W = 255? => write F
    1751         JZ      @1
    1752 
    1753   // P = W * F
    1754         AND     EAX,$00FF00FF   // EAX  <-  00 Fr 00 Fb
    1755         AND     ECX,$FF00FF00   // ECX  <-  Fa 00 Fg 00
    1756         IMUL    EAX,R8D         // EAX  <-  Pr ** Pb **
    1757         SHR     ECX,8           // ECX  <-  00 Fa 00 Fg
    1758         IMUL    ECX,R8D         // ECX  <-  00 00 Pg **
    1759         ADD     EAX,bias
    1760         AND     EAX,$FF00FF00   // EAX  <-  Pr 00 Pb 00
    1761         SHR     EAX,8           // EAX  <-  00 Pr 00 Pb
    1762         ADD     ECX,bias
    1763         AND     ECX,$FF00FF00   // ECX  <-  Pa 00 Pg 00
    1764         OR      EAX,ECX         // EAX  <-  00 Pr Pg Pb
    1765 
    1766   // W = 1 - W; Q = W * B
    1767         MOV     R9D,[RDX]
    1768         XOR     R8D,$000000FF   // R8D  <-  1 - R8D
    1769         MOV     ECX,R9D         // ECX  <-  Ba Br Bg Bb
    1770         AND     R9D,$00FF00FF   // R9D  <-  00 Br 00 Bb
    1771         AND     ECX,$FF00FF00   // ECX  <-  Ba 00 Bg 00
    1772         IMUL    R9D,R8D         // R9D  <-  Qr ** Qb **
    1773         SHR     ECX,8           // ECX  <-  00 Ba 00 Bg
    1774         IMUL    ECX,R8D         // ECX  <-  Qa 00 Qg **
    1775         ADD     R9D,bias
    1776         AND     R9D,$FF00FF00   // R9D  <-  Qr 00 Qb 00
    1777         SHR     R9D,8           // R9D  <-  00 Qr ** Qb
    1778         ADD     ECX,bias
    1779         AND     ECX,$FF00FF00   // ECX  <-  Qa 00 Qg 00
    1780         OR      ECX,R9D         // ECX  <-  00 Qr Qg Qb
    1781 
    1782   // Z = P + Q (assuming no overflow at each byte)
    1783         ADD     EAX,ECX         // EAX  <-  00 Zr Zg Zb
    1784 
    1785 @1:     MOV     [RDX],EAX
    1786 @2:
    1787 
    1788 {$ENDIF}
    1789 end;
    1790 
    1791 procedure EMMS_ASM;
    1792 asm
    1793 end;
    1794859
    1795860procedure GenAlphaTable;
     
    1830895  FreeMem(AlphaTable);
    1831896end;
    1832 
    1833 {$IFNDEF OMIT_MMX}
    1834 
    1835 { MMX versions }
    1836 
    1837 function BlendReg_MMX(F, B: TColor32): TColor32;
    1838 asm
    1839   // blend foreground color (F) to a background color (B),
    1840   // using alpha channel value of F
    1841 {$IFDEF TARGET_x86}
    1842   // EAX <- F
    1843   // EDX <- B
    1844   // Result := Fa * (Frgb - Brgb) + Brgb
    1845         MOVD      MM0,EAX
    1846         PXOR      MM3,MM3
    1847         MOVD      MM2,EDX
    1848         PUNPCKLBW MM0,MM3
    1849         MOV       ECX,bias_ptr
    1850         PUNPCKLBW MM2,MM3
    1851         MOVQ      MM1,MM0
    1852         PUNPCKHWD MM1,MM1
    1853         PSUBW     MM0,MM2
    1854         PUNPCKHDQ MM1,MM1
    1855         PSLLW     MM2,8
    1856         PMULLW    MM0,MM1
    1857         PADDW     MM2,[ECX]
    1858         PADDW     MM2,MM0
    1859         PSRLW     MM2,8
    1860         PACKUSWB  MM2,MM3
    1861         MOVD      EAX,MM2
    1862 {$ENDIF}
    1863 
    1864 {$IFDEF TARGET_x64}
    1865   // ECX <- F
    1866   // EDX <- B
    1867   // Result := Fa * (Frgb - Brgb) + Brgb
    1868         MOVD      MM0,ECX
    1869         PXOR      MM3,MM3
    1870         MOVD      MM2,EDX
    1871         PUNPCKLBW MM0,MM3
    1872         MOV       RAX,bias_ptr
    1873         PUNPCKLBW MM2,MM3
    1874         MOVQ      MM1,MM0
    1875         PUNPCKHWD MM1,MM1
    1876         PSUBW     MM0,MM2
    1877         PUNPCKHDQ MM1,MM1
    1878         PSLLW     MM2,8
    1879         PMULLW    MM0,MM1
    1880         PADDW     MM2,[RAX]
    1881         PADDW     MM2,MM0
    1882         PSRLW     MM2,8
    1883         PACKUSWB  MM2,MM3
    1884         MOVD      EAX,MM2
    1885 {$ENDIF}
    1886 end;
    1887 
    1888 {$IFDEF TARGET_x86}
    1889 
    1890 procedure BlendMem_MMX(F: TColor32; var B: TColor32);
    1891 asm
    1892   // EAX - Color X
    1893   // [EDX] - Color Y
    1894   // Result := W * (X - Y) + Y
    1895 
    1896         TEST      EAX,$FF000000
    1897         JZ        @1
    1898         CMP       EAX,$FF000000
    1899         JNC       @2
    1900 
    1901         PXOR      MM3,MM3
    1902         MOVD      MM0,EAX
    1903         MOVD      MM2,[EDX]
    1904         PUNPCKLBW MM0,MM3
    1905         MOV       ECX,bias_ptr
    1906         PUNPCKLBW MM2,MM3
    1907         MOVQ      MM1,MM0
    1908         PUNPCKHWD MM1,MM1
    1909         PSUBW     MM0,MM2
    1910         PUNPCKHDQ MM1,MM1
    1911         PSLLW     MM2,8
    1912         PMULLW    MM0,MM1
    1913         PADDW     MM2,[ECX]
    1914         PADDW     MM2,MM0
    1915         PSRLW     MM2,8
    1916         PACKUSWB  MM2,MM3
    1917         MOVD      [EDX],MM2
    1918 
    1919 {$IFDEF FPC}
    1920 @1:     JMP @3
    1921 {$ELSE}
    1922 @1:     RET
    1923 {$ENDIF}
    1924 
    1925 @2:     MOV       [EDX],EAX
    1926 @3:
    1927 end;
    1928 
    1929 function BlendRegEx_MMX(F, B, M: TColor32): TColor32;
    1930 asm
    1931   // blend foreground color (F) to a background color (B),
    1932   // using alpha channel value of F
    1933   // EAX <- F
    1934   // EDX <- B
    1935   // ECX <- M
    1936   // Result := M * Fa * (Frgb - Brgb) + Brgb
    1937         PUSH      EBX
    1938         MOV       EBX,EAX
    1939         SHR       EBX,24
    1940         INC       ECX             // 255:256 range bias
    1941         IMUL      ECX,EBX
    1942         SHR       ECX,8
    1943         JZ        @1
    1944 
    1945         PXOR      MM0,MM0
    1946         MOVD      MM1,EAX
    1947         SHL       ECX,4
    1948         MOVD      MM2,EDX
    1949         PUNPCKLBW MM1,MM0
    1950         PUNPCKLBW MM2,MM0
    1951         ADD       ECX,alpha_ptr
    1952         PSUBW     MM1,MM2
    1953         PMULLW    MM1,[ECX]
    1954         PSLLW     MM2,8
    1955         MOV       ECX,bias_ptr
    1956         PADDW     MM2,[ECX]
    1957         PADDW     MM1,MM2
    1958         PSRLW     MM1,8
    1959         PACKUSWB  MM1,MM0
    1960         MOVD      EAX,MM1
    1961 
    1962         POP       EBX
    1963 {$IFDEF FPC}
    1964         JMP @2
    1965 {$ELSE}
    1966         RET
    1967 {$ENDIF}
    1968 
    1969 @1:     MOV       EAX,EDX
    1970         POP       EBX
    1971 @2:
    1972 end;
    1973 
    1974 {$ENDIF}
    1975 
    1976 procedure BlendMemEx_MMX(F: TColor32; var B:TColor32; M: TColor32);
    1977 asm
    1978 {$IFDEF TARGET_x86}
    1979   // blend foreground color (F) to a background color (B),
    1980   // using alpha channel value of F
    1981   // EAX <- F
    1982   // [EDX] <- B
    1983   // ECX <- M
    1984   // Result := M * Fa * (Frgb - Brgb) + Brgb
    1985         TEST      EAX,$FF000000
    1986         JZ        @2
    1987 
    1988         PUSH      EBX
    1989         MOV       EBX,EAX
    1990         SHR       EBX,24
    1991         INC       ECX             // 255:256 range bias
    1992         IMUL      ECX,EBX
    1993         SHR       ECX,8
    1994         JZ        @1
    1995 
    1996         PXOR      MM0,MM0
    1997         MOVD      MM1,EAX
    1998         SHL       ECX,4
    1999         MOVD      MM2,[EDX]
    2000         PUNPCKLBW MM1,MM0
    2001         PUNPCKLBW MM2,MM0
    2002         ADD       ECX,alpha_ptr
    2003         PSUBW     MM1,MM2
    2004         PMULLW    MM1,[ECX]
    2005         PSLLW     MM2,8
    2006         MOV       ECX,bias_ptr
    2007         PADDW     MM2,[ECX]
    2008         PADDW     MM1,MM2
    2009         PSRLW     MM1,8
    2010         PACKUSWB  MM1,MM0
    2011         MOVD      [EDX],MM1
    2012 
    2013 @1:     POP       EBX
    2014 
    2015 @2:
    2016 {$ENDIF}
    2017 
    2018 {$IFDEF TARGET_x64}
    2019   // blend foreground color (F) to a background color (B),
    2020   // using alpha channel value of F
    2021   // ECX <- F
    2022   // [EDX] <- B
    2023   // R8 <- M
    2024   // Result := M * Fa * (Frgb - Brgb) + Brgb
    2025         TEST      ECX,$FF000000
    2026         JZ        @1
    2027 
    2028         MOV       EAX,ECX
    2029         SHR       EAX,24
    2030         INC       R8D             // 255:256 range bias
    2031         IMUL      R8D,EAX
    2032         SHR       R8D,8
    2033         JZ        @1
    2034 
    2035         PXOR      MM0,MM0
    2036         MOVD      MM1,ECX
    2037         SHL       R8D,4
    2038         MOVD      MM2,[RDX]
    2039         PUNPCKLBW MM1,MM0
    2040         PUNPCKLBW MM2,MM0
    2041         ADD       R8,alpha_ptr
    2042         PSUBW     MM1,MM2
    2043         PMULLW    MM1,[R8]
    2044         PSLLW     MM2,8
    2045         MOV       RAX,bias_ptr
    2046         PADDW     MM2,[RAX]
    2047         PADDW     MM1,MM2
    2048         PSRLW     MM1,8
    2049         PACKUSWB  MM1,MM0
    2050         MOVD      [RDX],MM1
    2051 
    2052 @1:
    2053 {$ENDIF}
    2054 end;
    2055 
    2056 {$IFDEF TARGET_x86}
    2057 procedure BlendLine_MMX(Src, Dst: PColor32; Count: Integer);
    2058 asm
    2059   // EAX <- Src
    2060   // EDX <- Dst
    2061   // ECX <- Count
    2062 
    2063   // test the counter for zero or negativity
    2064         TEST      ECX,ECX
    2065         JS        @4
    2066 
    2067         PUSH      ESI
    2068         PUSH      EDI
    2069 
    2070         MOV       ESI,EAX         // ESI <- Src
    2071         MOV       EDI,EDX         // EDI <- Dst
    2072 
    2073   // loop start
    2074 @1:     MOV       EAX,[ESI]
    2075         TEST      EAX,$FF000000
    2076         JZ        @3              // complete transparency, proceed to next point
    2077         CMP       EAX,$FF000000
    2078         JNC       @2              // opaque pixel, copy without blending
    2079 
    2080   // blend
    2081         MOVD      MM0,EAX         // MM0  <-  00 00 00 00 Fa Fr Fg Fb
    2082         PXOR      MM3,MM3         // MM3  <-  00 00 00 00 00 00 00 00
    2083         MOVD      MM2,[EDI]       // MM2  <-  00 00 00 00 Ba Br Bg Bb
    2084         PUNPCKLBW MM0,MM3         // MM0  <-  00 Fa 00 Fr 00 Fg 00 Fb
    2085         MOV       EAX,bias_ptr
    2086         PUNPCKLBW MM2,MM3         // MM2  <-  00 Ba 00 Br 00 Bg 00 Bb
    2087         MOVQ      MM1,MM0         // MM1  <-  00 Fa 00 Fr 00 Fg 00 Fb
    2088         PUNPCKHWD MM1,MM1         // MM1  <-  00 Fa 00 Fa 00 ** 00 **
    2089         PSUBW     MM0,MM2         // MM0  <-  00 Da 00 Dr 00 Dg 00 Db
    2090         PUNPCKHDQ MM1,MM1         // MM1  <-  00 Fa 00 Fa 00 Fa 00 Fa
    2091         PSLLW     MM2,8           // MM2  <-  Ba 00 Br 00 Bg 00 Bb 00
    2092         PMULLW    MM0,MM1         // MM2  <-  Pa ** Pr ** Pg ** Pb **
    2093         PADDW     MM2,[EAX]       // add bias
    2094         PADDW     MM2,MM0         // MM2  <-  Qa ** Qr ** Qg ** Qb **
    2095         PSRLW     MM2,8           // MM2  <-  00 Qa 00 Qr 00 Qg 00 Qb
    2096         PACKUSWB  MM2,MM3         // MM2  <-  00 00 00 00 Qa Qr Qg Qb
    2097         MOVD      EAX,MM2
    2098 
    2099 @2:     MOV       [EDI],EAX
    2100 
    2101 @3:     ADD       ESI,4
    2102         ADD       EDI,4
    2103 
    2104   // loop end
    2105         DEC       ECX
    2106         JNZ       @1
    2107 
    2108         POP       EDI
    2109         POP       ESI
    2110 
    2111 @4:
    2112 end;
    2113 
    2114 procedure BlendLineEx_MMX(Src, Dst: PColor32; Count: Integer; M: TColor32);
    2115 asm
    2116   // EAX <- Src
    2117   // EDX <- Dst
    2118   // ECX <- Count
    2119 
    2120   // test the counter for zero or negativity
    2121         TEST      ECX,ECX
    2122         JS        @4
    2123 
    2124         PUSH      ESI
    2125         PUSH      EDI
    2126         PUSH      EBX
    2127 
    2128         MOV       ESI,EAX         // ESI <- Src
    2129         MOV       EDI,EDX         // EDI <- Dst
    2130         MOV       EDX,M           // EDX <- Master Alpha
    2131 
    2132   // loop start
    2133 @1:     MOV       EAX,[ESI]
    2134         TEST      EAX,$FF000000
    2135         JZ        @3             // complete transparency, proceed to next point
    2136         MOV       EBX,EAX
    2137         SHR       EBX,24
    2138         INC       EBX            // 255:256 range bias
    2139         IMUL      EBX,EDX
    2140         SHR       EBX,8
    2141         JZ        @3              // complete transparency, proceed to next point
    2142 
    2143   // blend
    2144         PXOR      MM0,MM0
    2145         MOVD      MM1,EAX
    2146         SHL       EBX,4
    2147         MOVD      MM2,[EDI]
    2148         PUNPCKLBW MM1,MM0
    2149         PUNPCKLBW MM2,MM0
    2150         ADD       EBX,alpha_ptr
    2151         PSUBW     MM1,MM2
    2152         PMULLW    MM1,[EBX]
    2153         PSLLW     MM2,8
    2154         MOV       EBX,bias_ptr
    2155         PADDW     MM2,[EBX]
    2156         PADDW     MM1,MM2
    2157         PSRLW     MM1,8
    2158         PACKUSWB  MM1,MM0
    2159         MOVD      EAX,MM1
    2160 
    2161 @2:     MOV       [EDI],EAX
    2162 
    2163 @3:     ADD       ESI,4
    2164         ADD       EDI,4
    2165 
    2166   // loop end
    2167         DEC       ECX
    2168         JNZ       @1
    2169 
    2170         POP       EBX
    2171         POP       EDI
    2172         POP       ESI
    2173 @4:
    2174 end;
    2175 
    2176 {$ENDIF}
    2177 
    2178 function CombineReg_MMX(X, Y, W: TColor32): TColor32;
    2179 asm
    2180 {$IFDEF TARGET_X86}
    2181   // EAX - Color X
    2182   // EDX - Color Y
    2183   // ECX - Weight of X [0..255]
    2184   // Result := W * (X - Y) + Y
    2185 
    2186         MOVD      MM1,EAX
    2187         PXOR      MM0,MM0
    2188         SHL       ECX,4
    2189 
    2190         MOVD      MM2,EDX
    2191         PUNPCKLBW MM1,MM0
    2192         PUNPCKLBW MM2,MM0
    2193 
    2194         ADD       ECX,alpha_ptr
    2195 
    2196         PSUBW     MM1,MM2
    2197         PMULLW    MM1,[ECX]
    2198         PSLLW     MM2,8
    2199 
    2200         MOV       ECX,bias_ptr
    2201 
    2202         PADDW     MM2,[ECX]
    2203         PADDW     MM1,MM2
    2204         PSRLW     MM1,8
    2205         PACKUSWB  MM1,MM0
    2206         MOVD      EAX,MM1
    2207 {$ENDIF}
    2208 
    2209 {$IFDEF TARGET_X64}
    2210   // ECX - Color X
    2211   // EDX - Color Y
    2212   // R8 - Weight of X [0..255]
    2213   // Result := W * (X - Y) + Y
    2214 
    2215         MOVD      MM1,ECX
    2216         PXOR      MM0,MM0
    2217         SHL       R8D,4
    2218 
    2219         MOVD      MM2,EDX
    2220         PUNPCKLBW MM1,MM0
    2221         PUNPCKLBW MM2,MM0
    2222 
    2223         ADD       R8,alpha_ptr
    2224 
    2225         PSUBW     MM1,MM2
    2226         PMULLW    MM1,[R8]
    2227         PSLLW     MM2,8
    2228 
    2229         MOV       RAX,bias_ptr
    2230 
    2231         PADDW     MM2,[RAX]
    2232         PADDW     MM1,MM2
    2233         PSRLW     MM1,8
    2234         PACKUSWB  MM1,MM0
    2235         MOVD      EAX,MM1
    2236 {$ENDIF}
    2237 end;
    2238 
    2239 procedure CombineMem_MMX(F: TColor32; var B: TColor32; W: TColor32);
    2240 asm
    2241 {$IFDEF TARGET_X86}
    2242   // EAX - Color X
    2243   // [EDX] - Color Y
    2244   // ECX - Weight of X [0..255]
    2245   // Result := W * (X - Y) + Y
    2246 
    2247         JCXZ      @1
    2248         CMP       ECX,$FF
    2249         JZ        @2
    2250 
    2251         MOVD      MM1,EAX
    2252         PXOR      MM0,MM0
    2253 
    2254         SHL       ECX,4
    2255 
    2256         MOVD      MM2,[EDX]
    2257         PUNPCKLBW MM1,MM0
    2258         PUNPCKLBW MM2,MM0
    2259 
    2260         ADD       ECX,alpha_ptr
    2261 
    2262         PSUBW     MM1,MM2
    2263         PMULLW    MM1,[ECX]
    2264         PSLLW     MM2,8
    2265 
    2266         MOV       ECX,bias_ptr
    2267 
    2268         PADDW     MM2,[ECX]
    2269         PADDW     MM1,MM2
    2270         PSRLW     MM1,8
    2271         PACKUSWB  MM1,MM0
    2272         MOVD      [EDX],MM1
    2273 
    2274 {$IFDEF FPC}
    2275 @1:     JMP @3
    2276 {$ELSE}
    2277 @1:     RET
    2278 {$ENDIF}
    2279 
    2280 @2:     MOV       [EDX],EAX
    2281 @3:
    2282 {$ENDIF}
    2283 
    2284 {$IFDEF TARGET_x64}
    2285   // ECX - Color X
    2286   // [RDX] - Color Y
    2287   // R8 - Weight of X [0..255]
    2288   // Result := W * (X - Y) + Y
    2289 
    2290         TEST      R8D,R8D            // Set flags for R8
    2291         JZ        @1                 // W = 0 ?  => Result := EDX
    2292         CMP       R8D,$FF
    2293         JZ        @2
    2294 
    2295         MOVD      MM1,ECX
    2296         PXOR      MM0,MM0
    2297 
    2298         SHL       R8D,4
    2299 
    2300         MOVD      MM2,[RDX]
    2301         PUNPCKLBW MM1,MM0
    2302         PUNPCKLBW MM2,MM0
    2303 
    2304         ADD       R8,alpha_ptr
    2305 
    2306         PSUBW     MM1,MM2
    2307         PMULLW    MM1,[R8]
    2308         PSLLW     MM2,8
    2309 
    2310         MOV       RAX,bias_ptr
    2311 
    2312         PADDW     MM2,[RAX]
    2313         PADDW     MM1,MM2
    2314         PSRLW     MM1,8
    2315         PACKUSWB  MM1,MM0
    2316         MOVD      [RDX],MM1
    2317 
    2318 {$IFDEF FPC}
    2319 @1:     JMP @3
    2320 {$ELSE}
    2321 @1:     RET
    2322 {$ENDIF}
    2323 
    2324 @2:     MOV       [RDX],RCX
    2325 @3:
    2326 {$ENDIF}
    2327 end;
    2328 
    2329 {$IFDEF TARGET_x86}
    2330 
    2331 procedure CombineLine_MMX(Src, Dst: PColor32; Count: Integer; W: TColor32);
    2332 asm
    2333   // EAX <- Src
    2334   // EDX <- Dst
    2335   // ECX <- Count
    2336 
    2337   // Result := W * (X - Y) + Y
    2338 
    2339         TEST      ECX,ECX
    2340         JS        @3
    2341 
    2342         PUSH      EBX
    2343         MOV       EBX,W
    2344 
    2345         TEST      EBX,EBX
    2346         JZ        @2              // weight is zero
    2347 
    2348         CMP       EBX,$FF
    2349         JZ        @4              // weight = 255  =>  copy src to dst
    2350 
    2351         SHL       EBX,4
    2352         ADD       EBX,alpha_ptr
    2353         MOVQ      MM3,[EBX]
    2354         MOV       EBX,bias_ptr
    2355         MOVQ      MM4,[EBX]
    2356 
    2357    // loop start
    2358 @1:     MOVD      MM1,[EAX]
    2359         PXOR      MM0,MM0
    2360         MOVD      MM2,[EDX]
    2361         PUNPCKLBW MM1,MM0
    2362         PUNPCKLBW MM2,MM0
    2363 
    2364         PSUBW     MM1,MM2
    2365         PMULLW    MM1,MM3
    2366         PSLLW     MM2,8
    2367 
    2368         PADDW     MM2,MM4
    2369         PADDW     MM1,MM2
    2370         PSRLW     MM1,8
    2371         PACKUSWB  MM1,MM0
    2372         MOVD      [EDX],MM1
    2373 
    2374         ADD       EAX,4
    2375         ADD       EDX,4
    2376 
    2377         DEC       ECX
    2378         JNZ       @1
    2379 @2:     POP       EBX
    2380         POP       EBP
    2381 @3:     RET       $0004
    2382 
    2383 @4:     CALL      GR32_LowLevel.MoveLongword
    2384         POP       EBX
    2385 end;
    2386 
    2387 {$ENDIF}
    2388 
    2389 procedure EMMS_MMX;
    2390 asm
    2391   EMMS
    2392 end;
    2393 
    2394 function LightenReg_MMX(C: TColor32; Amount: Integer): TColor32;
    2395 asm
    2396 {$IFDEF TARGET_X86}
    2397         MOVD    MM0,EAX
    2398         TEST    EDX,EDX
    2399         JL      @1
    2400         IMUL    EDX,$010101
    2401         MOVD    MM1,EDX
    2402         PADDUSB MM0,MM1
    2403         MOVD    EAX,MM0
    2404         RET
    2405 @1:     NEG     EDX
    2406         IMUL    EDX,$010101
    2407         MOVD    MM1,EDX
    2408         PSUBUSB MM0,MM1
    2409         MOVD    EAX,MM0
    2410 {$ENDIF}
    2411 
    2412 {$IFDEF TARGET_X64}
    2413         MOVD    MM0,ECX
    2414         TEST    EDX,EDX
    2415         JL      @1
    2416         IMUL    EDX,$010101
    2417         MOVD    MM1,EDX
    2418         PADDUSB MM0,MM1
    2419         MOVD    EAX,MM0
    2420         RET
    2421 @1:     NEG     EDX
    2422         IMUL    EDX,$010101
    2423         MOVD    MM1,EDX
    2424         PSUBUSB MM0,MM1
    2425         MOVD    EAX,MM0
    2426 {$ENDIF}
    2427 end;
    2428 
    2429 { MMX Color algebra versions }
    2430 
    2431 function ColorAdd_MMX(C1, C2: TColor32): TColor32;
    2432 asm
    2433 {$IFDEF TARGET_X86}
    2434         MOVD      MM0,EAX
    2435         MOVD      MM1,EDX
    2436         PADDUSB   MM0,MM1
    2437         MOVD      EAX,MM0
    2438 {$ENDIF}
    2439 
    2440 {$IFDEF TARGET_X64}
    2441         MOVD      MM0,ECX
    2442         MOVD      MM1,EDX
    2443         PADDUSB   MM0,MM1
    2444         MOVD      EAX,MM0
    2445 {$ENDIF}
    2446 end;
    2447 
    2448 function ColorSub_MMX(C1, C2: TColor32): TColor32;
    2449 asm
    2450 {$IFDEF TARGET_X86}
    2451         MOVD      MM0,EAX
    2452         MOVD      MM1,EDX
    2453         PSUBUSB   MM0,MM1
    2454         MOVD      EAX,MM0
    2455 {$ENDIF}
    2456 
    2457 {$IFDEF TARGET_X64}
    2458         MOVD      MM0,ECX
    2459         MOVD      MM1,EDX
    2460         PSUBUSB   MM0,MM1
    2461         MOVD      EAX,MM0
    2462 {$ENDIF}
    2463 end;
    2464 
    2465 function ColorModulate_MMX(C1, C2: TColor32): TColor32;
    2466 asm
    2467 {$IFDEF TARGET_X86}
    2468         PXOR      MM2,MM2
    2469         MOVD      MM0,EAX
    2470         PUNPCKLBW MM0,MM2
    2471         MOVD      MM1,EDX
    2472         PUNPCKLBW MM1,MM2
    2473         PMULLW    MM0,MM1
    2474         PSRLW     MM0,8
    2475         PACKUSWB  MM0,MM2
    2476         MOVD      EAX,MM0
    2477 {$ENDIF}
    2478 
    2479 {$IFDEF TARGET_X64}
    2480         PXOR      MM2,MM2
    2481         MOVD      MM0,ECX
    2482         PUNPCKLBW MM0,MM2
    2483         MOVD      MM1,EDX
    2484         PUNPCKLBW MM1,MM2
    2485         PMULLW    MM0,MM1
    2486         PSRLW     MM0,8
    2487         PACKUSWB  MM0,MM2
    2488         MOVD      EAX,MM0
    2489 {$ENDIF}
    2490 end;
    2491 
    2492 function ColorMax_EMMX(C1, C2: TColor32): TColor32;
    2493 asm
    2494 {$IFDEF TARGET_X86}
    2495         MOVD      MM0,EAX
    2496         MOVD      MM1,EDX
    2497         PMAXUB    MM0,MM1
    2498         MOVD      EAX,MM0
    2499 {$ENDIF}
    2500 
    2501 {$IFDEF TARGET_X64}
    2502         MOVD      MM0,ECX
    2503         MOVD      MM1,EDX
    2504         PMAXUB    MM0,MM1
    2505         MOVD      EAX,MM0
    2506 {$ENDIF}
    2507 end;
    2508 
    2509 function ColorMin_EMMX(C1, C2: TColor32): TColor32;
    2510 asm
    2511 {$IFDEF TARGET_X86}
    2512         MOVD      MM0,EAX
    2513         MOVD      MM1,EDX
    2514         PMINUB    MM0,MM1
    2515         MOVD      EAX,MM0
    2516 {$ENDIF}
    2517 
    2518 {$IFDEF TARGET_X64}
    2519         MOVD      MM0,ECX
    2520         MOVD      MM1,EDX
    2521         PMINUB    MM0,MM1
    2522         MOVD      EAX,MM0
    2523 {$ENDIF}
    2524 end;
    2525 
    2526 function ColorDifference_MMX(C1, C2: TColor32): TColor32;
    2527 asm
    2528 {$IFDEF TARGET_X86}
    2529         MOVD      MM0,EAX
    2530         MOVD      MM1,EDX
    2531         MOVQ      MM2,MM0
    2532         PSUBUSB   MM0,MM1
    2533         PSUBUSB   MM1,MM2
    2534         POR       MM0,MM1
    2535         MOVD      EAX,MM0
    2536 {$ENDIF}
    2537 
    2538 {$IFDEF TARGET_X64}
    2539         MOVD      MM0,ECX
    2540         MOVD      MM1,EDX
    2541         MOVQ      MM2,MM0
    2542         PSUBUSB   MM0,MM1
    2543         PSUBUSB   MM1,MM2
    2544         POR       MM0,MM1
    2545         MOVD      EAX,MM0
    2546 {$ENDIF}
    2547 end;
    2548 
    2549 function ColorExclusion_MMX(C1, C2: TColor32): TColor32;
    2550 asm
    2551 {$IFDEF TARGET_X86}
    2552         PXOR      MM2,MM2
    2553         MOVD      MM0,EAX
    2554         PUNPCKLBW MM0,MM2
    2555         MOVD      MM1,EDX
    2556         PUNPCKLBW MM1,MM2
    2557         MOVQ      MM3,MM0
    2558         PADDW     MM0,MM1
    2559         PMULLW    MM1,MM3
    2560         PSRLW     MM1,7
    2561         PSUBUSW   MM0,MM1
    2562         PACKUSWB  MM0,MM2
    2563         MOVD      EAX,MM0
    2564 {$ENDIF}
    2565 
    2566 {$IFDEF TARGET_X64}
    2567         PXOR      MM2,MM2
    2568         MOVD      MM0,ECX
    2569         PUNPCKLBW MM0,MM2
    2570         MOVD      MM1,EDX
    2571         PUNPCKLBW MM1,MM2
    2572         MOVQ      MM3,MM0
    2573         PADDW     MM0,MM1
    2574         PMULLW    MM1,MM3
    2575         PSRLW     MM1,7
    2576         PSUBUSW   MM0,MM1
    2577         PACKUSWB  MM0,MM2
    2578         MOVD      EAX,MM0
    2579 {$ENDIF}
    2580 end;
    2581 
    2582 function ColorScale_MMX(C, W: TColor32): TColor32;
    2583 asm
    2584 {$IFDEF TARGET_X86}
    2585         PXOR      MM2,MM2
    2586         SHL       EDX,4
    2587         MOVD      MM0,EAX
    2588         PUNPCKLBW MM0,MM2
    2589         ADD       EDX,alpha_ptr
    2590         PMULLW    MM0,[EDX]
    2591         PSRLW     MM0,8
    2592         PACKUSWB  MM0,MM2
    2593         MOVD      EAX,MM0
    2594 {$ENDIF}
    2595 
    2596 {$IFDEF TARGET_X64}
    2597         PXOR      MM2,MM2
    2598         SHL       RDX,4
    2599         MOVD      MM0,ECX
    2600         PUNPCKLBW MM0,MM2
    2601         ADD       RDX,alpha_ptr
    2602         PMULLW    MM0,[RDX]
    2603         PSRLW     MM0,8
    2604         PACKUSWB  MM0,MM2
    2605         MOVD      EAX,MM0
    2606 {$ENDIF}
    2607 end;
    2608 {$ENDIF}
    2609 
    2610 
    2611 { SSE2 versions }
    2612 
    2613 {$IFNDEF OMIT_SSE2}
    2614 
    2615 function BlendReg_SSE2(F, B: TColor32): TColor32;
    2616 asm
    2617   // blend foreground color (F) to a background color (B),
    2618   // using alpha channel value of F
    2619   // EAX <- F
    2620   // EDX <- B
    2621   // Result := Fa * (Frgb - Brgb) + Brgb
    2622 
    2623 {$IFDEF TARGET_x86}
    2624         MOVD      XMM0,EAX
    2625         PXOR      XMM3,XMM3
    2626         MOVD      XMM2,EDX
    2627         PUNPCKLBW XMM0,XMM3
    2628         MOV       ECX,bias_ptr
    2629         PUNPCKLBW XMM2,XMM3
    2630         MOVQ      XMM1,XMM0
    2631         PSHUFLW   XMM1,XMM1, $FF
    2632         PSUBW     XMM0,XMM2
    2633         PSLLW     XMM2,8
    2634         PMULLW    XMM0,XMM1
    2635         PADDW     XMM2,[ECX]
    2636         PADDW     XMM2,XMM0
    2637         PSRLW     XMM2,8
    2638         PACKUSWB  XMM2,XMM3
    2639         MOVD      EAX,XMM2
    2640 {$ENDIF}
    2641 
    2642 {$IFDEF TARGET_x64}
    2643         MOVD      XMM0,ECX
    2644         PXOR      XMM3,XMM3
    2645         MOVD      XMM2,EDX
    2646         PUNPCKLBW XMM0,XMM3
    2647         MOV       RAX,bias_ptr
    2648         PUNPCKLBW XMM2,XMM3
    2649         MOVQ      XMM1,XMM0
    2650         PSHUFLW   XMM1,XMM1, $FF
    2651         PSUBW     XMM0,XMM2
    2652         PSLLW     XMM2,8
    2653         PMULLW    XMM0,XMM1
    2654         PADDW     XMM2,[RAX]
    2655         PADDW     XMM2,XMM0
    2656         PSRLW     XMM2,8
    2657         PACKUSWB  XMM2,XMM3
    2658         MOVD      EAX,XMM2
    2659 {$ENDIF}
    2660 end;
    2661 
    2662 procedure BlendMem_SSE2(F: TColor32; var B: TColor32);
    2663 asm
    2664 {$IFDEF TARGET_x86}
    2665   // EAX - Color X
    2666   // [EDX] - Color Y
    2667   // Result := W * (X - Y) + Y
    2668 
    2669         TEST      EAX,$FF000000
    2670         JZ        @1
    2671         CMP       EAX,$FF000000
    2672         JNC       @2
    2673 
    2674         PXOR      XMM3,XMM3
    2675         MOVD      XMM0,EAX
    2676         MOVD      XMM2,[EDX]
    2677         PUNPCKLBW XMM0,XMM3
    2678         MOV       ECX,bias_ptr
    2679         PUNPCKLBW XMM2,XMM3
    2680         MOVQ      XMM1,XMM0
    2681         PSHUFLW   XMM1,XMM1, $FF
    2682         PSUBW     XMM0,XMM2
    2683         PSLLW     XMM2,8
    2684         PMULLW    XMM0,XMM1
    2685         PADDW     XMM2,[ECX]
    2686         PADDW     XMM2,XMM0
    2687         PSRLW     XMM2,8
    2688         PACKUSWB  XMM2,XMM3
    2689         MOVD      [EDX],XMM2
    2690 
    2691 {$IFDEF FPC}
    2692 @1:     JMP @3
    2693 {$ELSE}
    2694 @1:     RET
    2695 {$ENDIF}
    2696 
    2697 @2:     MOV       [EDX], EAX
    2698 @3:
    2699 {$ENDIF}
    2700 
    2701 {$IFDEF TARGET_x64}
    2702   // ECX - Color X
    2703   // [EDX] - Color Y
    2704   // Result := W * (X - Y) + Y
    2705 
    2706         TEST      ECX,$FF000000
    2707         JZ        @1
    2708         CMP       ECX,$FF000000
    2709         JNC       @2
    2710 
    2711         PXOR      XMM3,XMM3
    2712         MOVD      XMM0,ECX
    2713         MOVD      XMM2,[RDX]
    2714         PUNPCKLBW XMM0,XMM3
    2715         MOV       RAX,bias_ptr
    2716         PUNPCKLBW XMM2,XMM3
    2717         MOVQ      XMM1,XMM0
    2718         PSHUFLW   XMM1,XMM1, $FF
    2719         PSUBW     XMM0,XMM2
    2720         PSLLW     XMM2,8
    2721         PMULLW    XMM0,XMM1
    2722         PADDW     XMM2,[RAX]
    2723         PADDW     XMM2,XMM0
    2724         PSRLW     XMM2,8
    2725         PACKUSWB  XMM2,XMM3
    2726         MOVD      [RDX],XMM2
    2727 
    2728 {$IFDEF FPC}
    2729 @1:     JMP @3
    2730 {$ELSE}
    2731 @1:     RET
    2732 {$ENDIF}
    2733 
    2734 @2:     MOV       [RDX], ECX
    2735 @3:
    2736 {$ENDIF}
    2737 end;
    2738 
    2739 function BlendRegEx_SSE2(F, B, M: TColor32): TColor32;
    2740 asm
    2741   // blend foreground color (F) to a background color (B),
    2742   // using alpha channel value of F
    2743   // Result := M * Fa * (Frgb - Brgb) + Brgb
    2744 
    2745 {$IFDEF TARGET_x86}
    2746   // EAX <- F
    2747   // EDX <- B
    2748   // ECX <- M
    2749         PUSH      EBX
    2750         MOV       EBX,EAX
    2751         SHR       EBX,24
    2752         INC       ECX             // 255:256 range bias
    2753         IMUL      ECX,EBX
    2754         SHR       ECX,8
    2755         JZ        @1
    2756 
    2757         PXOR      XMM0,XMM0
    2758         MOVD      XMM1,EAX
    2759         SHL       ECX,4
    2760         MOVD      XMM2,EDX
    2761         PUNPCKLBW XMM1,XMM0
    2762         PUNPCKLBW XMM2,XMM0
    2763         ADD       ECX,alpha_ptr
    2764         PSUBW     XMM1,XMM2
    2765         PMULLW    XMM1,[ECX]
    2766         PSLLW     XMM2,8
    2767         MOV       ECX,bias_ptr
    2768         PADDW     XMM2,[ECX]
    2769         PADDW     XMM1,XMM2
    2770         PSRLW     XMM1,8
    2771         PACKUSWB  XMM1,XMM0
    2772         MOVD      EAX,XMM1
    2773 
    2774         POP       EBX
    2775 {$IFDEF FPC}
    2776         JMP @2
    2777 {$ELSE}
    2778         RET
    2779 {$ENDIF}
    2780 
    2781 @1:     MOV       EAX,EDX
    2782         POP       EBX
    2783 @2:
    2784 {$ENDIF}
    2785 
    2786 {$IFDEF TARGET_x64}
    2787   // ECX <- F
    2788   // EDX <- B
    2789   // R8D <- M
    2790 
    2791         MOV       EAX,ECX
    2792         SHR       EAX,24
    2793         INC       R8D             // 255:256 range bias
    2794         IMUL      R8D,EAX
    2795         SHR       R8D,8
    2796         JZ        @1
    2797 
    2798         PXOR      XMM0,XMM0
    2799         MOVD      XMM1,ECX
    2800         SHL       R8D,4
    2801         MOVD      XMM2,EDX
    2802         PUNPCKLBW XMM1,XMM0
    2803         PUNPCKLBW XMM2,XMM0
    2804         ADD       R8,alpha_ptr
    2805         PSUBW     XMM1,XMM2
    2806         PMULLW    XMM1,[R8]
    2807         PSLLW     XMM2,8
    2808         MOV       R8,bias_ptr
    2809         PADDW     XMM2,[R8]
    2810         PADDW     XMM1,XMM2
    2811         PSRLW     XMM1,8
    2812         PACKUSWB  XMM1,XMM0
    2813         MOVD      EAX,XMM1
    2814 {$IFDEF FPC}
    2815         JMP @2
    2816 {$ELSE}
    2817         RET
    2818 {$ENDIF}
    2819 
    2820 @1:     MOV       EAX,EDX
    2821 @2:
    2822 {$ENDIF}
    2823 end;
    2824 
    2825 procedure BlendMemEx_SSE2(F: TColor32; var B:TColor32; M: TColor32);
    2826 asm
    2827 {$IFDEF TARGET_x86}
    2828   // blend foreground color (F) to a background color (B),
    2829   // using alpha channel value of F
    2830   // EAX <- F
    2831   // [EDX] <- B
    2832   // ECX <- M
    2833   // Result := M * Fa * (Frgb - Brgb) + Brgb
    2834         TEST      EAX,$FF000000
    2835         JZ        @2
    2836 
    2837         PUSH      EBX
    2838         MOV       EBX,EAX
    2839         SHR       EBX,24
    2840         INC       ECX             // 255:256 range bias
    2841         IMUL      ECX,EBX
    2842         SHR       ECX,8
    2843         JZ        @1
    2844 
    2845         PXOR      XMM0,XMM0
    2846         MOVD      XMM1,EAX
    2847         SHL       ECX,4
    2848         MOVD      XMM2,[EDX]
    2849         PUNPCKLBW XMM1,XMM0
    2850         PUNPCKLBW XMM2,XMM0
    2851         ADD       ECX,alpha_ptr
    2852         PSUBW     XMM1,XMM2
    2853         PMULLW    XMM1,[ECX]
    2854         PSLLW     XMM2,8
    2855         MOV       ECX,bias_ptr
    2856         PADDW     XMM2,[ECX]
    2857         PADDW     XMM1,XMM2
    2858         PSRLW     XMM1,8
    2859         PACKUSWB  XMM1,XMM0
    2860         MOVD      [EDX],XMM1
    2861 
    2862 @1:
    2863         POP       EBX
    2864 
    2865 @2:
    2866 {$ENDIF}
    2867 
    2868 {$IFDEF TARGET_x64}
    2869   // blend foreground color (F) to a background color (B),
    2870   // using alpha channel value of F
    2871   // RCX <- F
    2872   // [RDX] <- B
    2873   // R8 <- M
    2874   // Result := M * Fa * (Frgb - Brgb) + Brgb
    2875 
    2876         TEST      ECX, $FF000000
    2877         JZ        @1
    2878 
    2879         MOV       R9D,ECX
    2880         SHR       R9D,24
    2881         INC       R8D            // 255:256 range bias
    2882         IMUL      R8D,R9D
    2883         SHR       R8D,8
    2884         JZ        @1
    2885 
    2886         PXOR      XMM0,XMM0
    2887         MOVD      XMM1,ECX
    2888         SHL       R8D,4
    2889         MOVD      XMM2,[RDX]
    2890         PUNPCKLBW XMM1,XMM0
    2891         PUNPCKLBW XMM2,XMM0
    2892         ADD       R8,alpha_ptr
    2893         PSUBW     XMM1,XMM2
    2894         PMULLW    XMM1,[R8]
    2895         PSLLW     XMM2,8
    2896         MOV       R8,bias_ptr
    2897         PADDW     XMM2,[R8]
    2898         PADDW     XMM1,XMM2
    2899         PSRLW     XMM1,8
    2900         PACKUSWB  XMM1,XMM0
    2901         MOVD      DWORD PTR [RDX],XMM1
    2902 @1:
    2903 {$ENDIF}
    2904 end;
    2905 
    2906 procedure BlendLine_SSE2(Src, Dst: PColor32; Count: Integer);
    2907 asm
    2908 {$IFDEF TARGET_X86}
    2909   // EAX <- Src
    2910   // EDX <- Dst
    2911   // ECX <- Count
    2912 
    2913         TEST      ECX,ECX
    2914         JZ        @4
    2915 
    2916         PUSH      EBX
    2917 
    2918         MOV       EBX,EAX
    2919 
    2920 @1:     MOV       EAX,[EBX]
    2921         TEST      EAX,$FF000000
    2922         JZ        @3
    2923         CMP       EAX,$FF000000
    2924         JNC       @2
    2925 
    2926         MOVD      XMM0,EAX
    2927         PXOR      XMM3,XMM3
    2928         MOVD      XMM2,[EDX]
    2929         PUNPCKLBW XMM0,XMM3
    2930         MOV       EAX,bias_ptr
    2931         PUNPCKLBW XMM2,XMM3
    2932         MOVQ      XMM1,XMM0
    2933         PUNPCKLBW XMM1,XMM3
    2934         PUNPCKHWD XMM1,XMM1
    2935         PSUBW     XMM0,XMM2
    2936         PUNPCKHDQ XMM1,XMM1
    2937         PSLLW     XMM2,8
    2938         PMULLW    XMM0,XMM1
    2939         PADDW     XMM2,[EAX]
    2940         PADDW     XMM2,XMM0
    2941         PSRLW     XMM2,8
    2942         PACKUSWB  XMM2,XMM3
    2943         MOVD      EAX, XMM2
    2944 
    2945 @2:     MOV       [EDX],EAX
    2946 
    2947 @3:     ADD       EBX,4
    2948         ADD       EDX,4
    2949 
    2950         DEC       ECX
    2951         JNZ       @1
    2952 
    2953         POP       EBX
    2954 
    2955 @4:
    2956 {$ENDIF}
    2957 
    2958 {$IFDEF TARGET_X64}
    2959   // ECX <- Src
    2960   // EDX <- Dst
    2961   // R8D <- Count
    2962 
    2963         TEST      R8D,R8D
    2964         JZ        @4
    2965 
    2966 @1:     MOV       EAX,[RCX]
    2967         TEST      EAX,$FF000000
    2968         JZ        @3
    2969         CMP       EAX,$FF000000
    2970         JNC       @2
    2971 
    2972         MOVD      XMM0,EAX
    2973         PXOR      XMM3,XMM3
    2974         MOVD      XMM2,[RDX]
    2975         PUNPCKLBW XMM0,XMM3
    2976         MOV       RAX,bias_ptr
    2977         PUNPCKLBW XMM2,XMM3
    2978         MOVQ      XMM1,XMM0
    2979         PUNPCKLBW XMM1,XMM3
    2980         PUNPCKHWD XMM1,XMM1
    2981         PSUBW     XMM0,XMM2
    2982         PUNPCKHDQ XMM1,XMM1
    2983         PSLLW     XMM2,8
    2984         PMULLW    XMM0,XMM1
    2985         PADDW     XMM2,[RAX]
    2986         PADDW     XMM2,XMM0
    2987         PSRLW     XMM2,8
    2988         PACKUSWB  XMM2,XMM3
    2989         MOVD      EAX, XMM2
    2990 
    2991 @2:     MOV       [RDX],EAX
    2992 
    2993 @3:     ADD       RCX,4
    2994         ADD       RDX,4
    2995 
    2996         DEC       R8D
    2997         JNZ       @1
    2998 
    2999 @4:
    3000 {$ENDIF}
    3001 end;
    3002 
    3003 
    3004 procedure BlendLineEx_SSE2(Src, Dst: PColor32; Count: Integer; M: TColor32);
    3005 asm
    3006 {$IFDEF TARGET_X86}
    3007   // EAX <- Src
    3008   // EDX <- Dst
    3009   // ECX <- Count
    3010 
    3011   // test the counter for zero or negativity
    3012         TEST      ECX,ECX
    3013         JS        @4
    3014 
    3015         PUSH      ESI
    3016         PUSH      EDI
    3017         PUSH      EBX
    3018 
    3019         MOV       ESI,EAX         // ESI <- Src
    3020         MOV       EDI,EDX         // EDI <- Dst
    3021         MOV       EDX,M           // EDX <- Master Alpha
    3022 
    3023   // loop start
    3024 @1:     MOV       EAX,[ESI]
    3025         TEST      EAX,$FF000000
    3026         JZ        @3             // complete transparency, proceed to next point
    3027         MOV       EBX,EAX
    3028         SHR       EBX,24
    3029         INC       EBX            // 255:256 range bias
    3030         IMUL      EBX,EDX
    3031         SHR       EBX,8
    3032         JZ        @3             // complete transparency, proceed to next point
    3033 
    3034   // blend
    3035         PXOR      XMM0,XMM0
    3036         MOVD      XMM1,EAX
    3037         SHL       EBX,4
    3038         MOVD      XMM2,[EDI]
    3039         PUNPCKLBW XMM1,XMM0
    3040         PUNPCKLBW XMM2,XMM0
    3041         ADD       EBX,alpha_ptr
    3042         PSUBW     XMM1,XMM2
    3043         PMULLW    XMM1,[EBX]
    3044         PSLLW     XMM2,8
    3045         MOV       EBX,bias_ptr
    3046         PADDW     XMM2,[EBX]
    3047         PADDW     XMM1,XMM2
    3048         PSRLW     XMM1,8
    3049         PACKUSWB  XMM1,XMM0
    3050         MOVD      EAX,XMM1
    3051 
    3052 @2:     MOV       [EDI],EAX
    3053 
    3054 @3:     ADD       ESI,4
    3055         ADD       EDI,4
    3056 
    3057   // loop end
    3058         DEC       ECX
    3059         JNZ       @1
    3060 
    3061         POP       EBX
    3062         POP       EDI
    3063         POP       ESI
    3064 @4:
    3065 {$ENDIF}
    3066 
    3067 {$IFDEF TARGET_X64}
    3068   // ECX <- Src
    3069   // EDX <- Dst
    3070   // R8D <- Count
    3071   // R9D <- M
    3072 
    3073   // test the counter for zero or negativity
    3074         TEST      R8D,R8D
    3075         JS        @4
    3076         TEST      R9D,R9D
    3077         JZ        @4
    3078 
    3079         MOV       R10,RCX         // ESI <- Src
    3080 
    3081   // loop start
    3082 @1:     MOV       ECX,[R10]
    3083         TEST      ECX,$FF000000
    3084         JZ        @3              // complete transparency, proceed to next point
    3085         MOV       EAX,ECX
    3086         SHR       EAX,24
    3087         INC       EAX             // 255:256 range bias
    3088         IMUL      EAX,R9D
    3089         SHR       EAX,8
    3090         JZ        @3              // complete transparency, proceed to next point
    3091 
    3092   // blend
    3093         PXOR      XMM0,XMM0
    3094         MOVD      XMM1,ECX
    3095         SHL       EAX,4
    3096         MOVD      XMM2,[RDX]
    3097         PUNPCKLBW XMM1,XMM0
    3098         PUNPCKLBW XMM2,XMM0
    3099         ADD       RAX,alpha_ptr
    3100         PSUBW     XMM1,XMM2
    3101         PMULLW    XMM1,[RAX]
    3102         PSLLW     XMM2,8
    3103         MOV       RAX,bias_ptr
    3104         PADDW     XMM2,[RAX]
    3105         PADDW     XMM1,XMM2
    3106         PSRLW     XMM1,8
    3107         PACKUSWB  XMM1,XMM0
    3108         MOVD      ECX,XMM1
    3109 
    3110 @2:     MOV       [RDX],ECX
    3111 
    3112 @3:     ADD       R10,4
    3113         ADD       RDX,4
    3114 
    3115   // loop end
    3116         DEC       R8D
    3117         JNZ       @1
    3118 @4:
    3119 {$ENDIF}
    3120 end;
    3121 
    3122 function CombineReg_SSE2(X, Y, W: TColor32): TColor32;
    3123 asm
    3124 {$IFDEF TARGET_X86}
    3125   // EAX - Color X
    3126   // EDX - Color Y
    3127   // ECX - Weight of X [0..255]
    3128   // Result := W * (X - Y) + Y
    3129 
    3130         MOVD      XMM1,EAX
    3131         PXOR      XMM0,XMM0
    3132         SHL       ECX,4
    3133 
    3134         MOVD      XMM2,EDX
    3135         PUNPCKLBW XMM1,XMM0
    3136         PUNPCKLBW XMM2,XMM0
    3137 
    3138         ADD       ECX,alpha_ptr
    3139 
    3140         PSUBW     XMM1,XMM2
    3141         PMULLW    XMM1,[ECX]
    3142         PSLLW     XMM2,8
    3143 
    3144         MOV       ECX,bias_ptr
    3145 
    3146         PADDW     XMM2,[ECX]
    3147         PADDW     XMM1,XMM2
    3148         PSRLW     XMM1,8
    3149         PACKUSWB  XMM1,XMM0
    3150         MOVD      EAX,XMM1
    3151 {$ENDIF}
    3152 
    3153 {$IFDEF TARGET_X64}
    3154   // ECX - Color X
    3155   // EDX - Color Y
    3156   // R8D - Weight of X [0..255]
    3157   // Result := W * (X - Y) + Y
    3158 
    3159         MOVD      XMM1,ECX
    3160         PXOR      XMM0,XMM0
    3161         SHL       R8D,4
    3162 
    3163         MOVD      XMM2,EDX
    3164         PUNPCKLBW XMM1,XMM0
    3165         PUNPCKLBW XMM2,XMM0
    3166 
    3167         ADD       R8,alpha_ptr
    3168 
    3169         PSUBW     XMM1,XMM2
    3170         PMULLW    XMM1,[R8]
    3171         PSLLW     XMM2,8
    3172 
    3173         MOV       R8,bias_ptr
    3174 
    3175         PADDW     XMM2,[R8]
    3176         PADDW     XMM1,XMM2
    3177         PSRLW     XMM1,8
    3178         PACKUSWB  XMM1,XMM0
    3179         MOVD      EAX,XMM1
    3180 {$ENDIF}
    3181 end;
    3182 
    3183 procedure CombineMem_SSE2(F: TColor32; var B: TColor32; W: TColor32);
    3184 asm
    3185 {$IFDEF TARGET_X86}
    3186   // EAX - Color X
    3187   // [EDX] - Color Y
    3188   // ECX - Weight of X [0..255]
    3189   // Result := W * (X - Y) + Y
    3190 
    3191         JCXZ    @1
    3192 
    3193         CMP       ECX,$FF
    3194         JZ        @2
    3195 
    3196         MOVD      XMM1,EAX
    3197         PXOR      XMM0,XMM0
    3198 
    3199         SHL       ECX,4
    3200 
    3201         MOVD      XMM2,[EDX]
    3202         PUNPCKLBW XMM1,XMM0
    3203         PUNPCKLBW XMM2,XMM0
    3204 
    3205         ADD       ECX,alpha_ptr
    3206 
    3207         PSUBW     XMM1,XMM2
    3208         PMULLW    XMM1,[ECX]
    3209         PSLLW     XMM2,8
    3210 
    3211         MOV       ECX,bias_ptr
    3212 
    3213         PADDW     XMM2,[ECX]
    3214         PADDW     XMM1,XMM2
    3215         PSRLW     XMM1,8
    3216         PACKUSWB  XMM1,XMM0
    3217         MOVD      [EDX],XMM1
    3218 
    3219 {$IFDEF FPC}
    3220 @1:     JMP @3
    3221 {$ELSE}
    3222 @1:     RET
    3223 {$ENDIF}
    3224 
    3225 @2:     MOV       [EDX],EAX
    3226 @3:
    3227 {$ENDIF}
    3228 
    3229 {$IFDEF TARGET_X64}
    3230   // ECX - Color X
    3231   // [RDX] - Color Y
    3232   // R8D - Weight of X [0..255]
    3233   // Result := W * (X - Y) + Y
    3234 
    3235         TEST      R8D,R8D            // Set flags for R8
    3236         JZ        @1                 // W = 0 ?  => Result := EDX
    3237         CMP       R8D,$FF
    3238         JZ        @2
    3239 
    3240         MOVD      XMM1,ECX
    3241         PXOR      XMM0,XMM0
    3242 
    3243         SHL       R8D,4
    3244 
    3245         MOVD      XMM2,[RDX]
    3246         PUNPCKLBW XMM1,XMM0
    3247         PUNPCKLBW XMM2,XMM0
    3248 
    3249         ADD       R8,alpha_ptr
    3250 
    3251         PSUBW     XMM1,XMM2
    3252         PMULLW    XMM1,[R8]
    3253         PSLLW     XMM2,8
    3254 
    3255         MOV       RAX,bias_ptr
    3256 
    3257         PADDW     XMM2,[RAX]
    3258         PADDW     XMM1,XMM2
    3259         PSRLW     XMM1,8
    3260         PACKUSWB  XMM1,XMM0
    3261         MOVD      [RDX],XMM1
    3262 
    3263 {$IFDEF FPC}
    3264 @1:     JMP @3
    3265 {$ELSE}
    3266 @1:     RET
    3267 {$ENDIF}
    3268 
    3269 @2:     MOV       [RDX],ECX
    3270 @3:
    3271 {$ENDIF}
    3272 end;
    3273 
    3274 
    3275 procedure CombineLine_SSE2(Src, Dst: PColor32; Count: Integer; W: TColor32);
    3276 asm
    3277 {$IFDEF TARGET_X86}
    3278   // EAX <- Src
    3279   // EDX <- Dst
    3280   // ECX <- Count
    3281 
    3282   // Result := W * (X - Y) + Y
    3283 
    3284         TEST      ECX,ECX
    3285         JZ        @3
    3286 
    3287         PUSH      EBX
    3288         MOV       EBX,W
    3289 
    3290         TEST      EBX,EBX
    3291         JZ        @2
    3292 
    3293         CMP       EBX,$FF
    3294         JZ        @4
    3295 
    3296         SHL       EBX,4
    3297         ADD       EBX,alpha_ptr
    3298         MOVQ      XMM3,[EBX]
    3299         MOV       EBX,bias_ptr
    3300         MOVQ      XMM4,[EBX]
    3301 
    3302 @1:     MOVD      XMM1,[EAX]
    3303         PXOR      XMM0,XMM0
    3304         MOVD      XMM2,[EDX]
    3305         PUNPCKLBW XMM1,XMM0
    3306         PUNPCKLBW XMM2,XMM0
    3307 
    3308         PSUBW     XMM1,XMM2
    3309         PMULLW    XMM1,XMM3
    3310         PSLLW     XMM2,8
    3311 
    3312         PADDW     XMM2,XMM4
    3313         PADDW     XMM1,XMM2
    3314         PSRLW     XMM1,8
    3315         PACKUSWB  XMM1,XMM0
    3316         MOVD      [EDX],XMM1
    3317 
    3318         ADD       EAX,4
    3319         ADD       EDX,4
    3320 
    3321         DEC       ECX
    3322         JNZ       @1
    3323 
    3324 @2:     POP       EBX
    3325         POP       EBP
    3326 
    3327 @3:     RET       $0004
    3328 
    3329 @4:     SHL       ECX,2
    3330         CALL      Move
    3331         POP       EBX
    3332 {$ENDIF}
    3333 
    3334 {$IFDEF TARGET_X64}
    3335   // ECX <- Src
    3336   // EDX <- Dst
    3337   // R8D <- Count
    3338 
    3339   // Result := W * (X - Y) + Y
    3340 
    3341         TEST      R8D,R8D
    3342         JZ        @2
    3343 
    3344         TEST      R9D,R9D
    3345         JZ        @2
    3346 
    3347         CMP       R9D,$FF
    3348         JZ        @3
    3349 
    3350         SHL       R9D,4
    3351         ADD       R9,alpha_ptr
    3352         MOVQ      XMM3,[R9]
    3353         MOV       R9,bias_ptr
    3354         MOVQ      XMM4,[R9]
    3355 
    3356 @1:     MOVD      XMM1,[RCX]
    3357         PXOR      XMM0,XMM0
    3358         MOVD      XMM2,[RDX]
    3359         PUNPCKLBW XMM1,XMM0
    3360         PUNPCKLBW XMM2,XMM0
    3361 
    3362         PSUBW     XMM1,XMM2
    3363         PMULLW    XMM1,XMM3
    3364         PSLLW     XMM2,8
    3365 
    3366         PADDW     XMM2,XMM4
    3367         PADDW     XMM1,XMM2
    3368         PSRLW     XMM1,8
    3369         PACKUSWB  XMM1,XMM0
    3370         MOVD      [RDX],XMM1
    3371 
    3372         ADD       RCX,4
    3373         ADD       RDX,4
    3374 
    3375         DEC       R8D
    3376         JNZ       @1
    3377 
    3378 {$IFDEF FPC}
    3379 @2:     JMP @4
    3380 {$ELSE}
    3381 @2:     RET
    3382 {$ENDIF}
    3383 
    3384 @3:     SHL       R8D,2
    3385         CALL      Move
    3386 @4:
    3387 {$ENDIF}
    3388 end;
    3389 
    3390 function MergeReg_SSE2(F, B: TColor32): TColor32;
    3391 asm
    3392   { This is an implementation of the merge formula, as described
    3393     in a paper by Bruce Wallace in 1981. Merging is associative,
    3394     that is, A over (B over C) = (A over B) over C. The formula is,
    3395 
    3396       Ra = Fa + Ba - Fa * Ba
    3397       Rc = (Fa (Fc - Bc * Ba) + Bc * Ba) / Ra
    3398 
    3399     where
    3400 
    3401       Rc is the resultant color,
    3402       Ra is the resultant alpha,
    3403       Fc is the foreground color,
    3404       Fa is the foreground alpha,
    3405       Bc is the background color,
    3406       Ba is the background alpha.
    3407 
    3408     Implementation:
    3409 
    3410       Ra := 1 - (1 - Fa) * (1 - Ba);
    3411       Wa := Fa / Ra;
    3412       Rc := Bc + Wa * (Fc - Bc);
    3413       // Rc := Bc + Wa * (Fc - Bc)
    3414 
    3415       (1 - Fa) * (1 - Ba) = 1 - Fa - Ba + Fa * Ba = (1 - Ra)
    3416   }
    3417 
    3418 {$IFDEF TARGET_X86}
    3419         TEST      EAX,$FF000000  // foreground completely transparent =>
    3420         JZ        @1             // result = background
    3421         CMP       EAX,$FF000000  // foreground completely opaque =>
    3422         JNC       @2             // result = foreground
    3423         TEST      EDX,$FF000000  // background completely transparent =>
    3424         JZ        @2             // result = foreground
    3425 
    3426         PXOR      XMM7,XMM7       // XMM7  <-  00
    3427         MOVD      XMM0,EAX        // XMM0  <-  Fa Fr Fg Fb
    3428         SHR       EAX,24          //  EAX  <-  Fa
    3429         ROR       EDX,24
    3430         MOVZX     ECX,DL          //  ECX  <-  Ba
    3431         PUNPCKLBW XMM0,XMM7       // XMM0  <-  00 Fa 00 Fr 00 Fg 00 Fb
    3432         SUB       EAX,$FF         //  EAX  <-  (Fa - 1)
    3433         XOR       ECX,$FF         //  ECX  <-  (1 - Ba)
    3434         IMUL      ECX,EAX         //  ECX  <-  (Fa - 1) * (1 - Ba)  =  Ra - 1
    3435         IMUL      ECX,$8081       //  ECX  <-  Xa 00 00 00
    3436         ADD       ECX,$8081*$FF*$FF
    3437         SHR       ECX,15          //  ECX  <-  Ra
    3438         MOV       DL,CH           //  EDX  <-  Br Bg Bb Ra
    3439         ROR       EDX,8           //  EDX  <-  Ra Br Bg Bb
    3440         MOVD      XMM1,EDX        // XMM1  <-  Ra Br Bg Bb
    3441         PUNPCKLBW XMM1,XMM7       // XMM1  <-  00 Ra 00 Br 00 Bg 00 Bb
    3442         SHL       EAX,20          //  EAX  <-  Fa 00 00
    3443         PSUBW     XMM0,XMM1       // XMM0  <-  ** Da ** Dr ** Dg ** Db
    3444         ADD       EAX,$0FF01000
    3445         PSLLW     XMM0,4
    3446         XOR       EDX,EDX         //  EDX  <-  00
    3447         DIV       ECX             //  EAX  <-  Fa / Ra  =  Wa
    3448         MOVD      XMM4,EAX        // XMM3  <-  Wa
    3449         PSHUFLW   XMM4,XMM4,$C0   // XMM3  <-  00 00 ** Wa ** Wa ** Wa
    3450         PMULHW    XMM0,XMM4       // XMM0  <-  00 00 ** Pr ** Pg ** Pb
    3451         PADDW     XMM0,XMM1       // XMM0  <-  00 Ra 00 Rr 00 Rg 00 Rb
    3452         PACKUSWB  XMM0,XMM7       // XMM0  <-  Ra Rr Rg Rb
    3453         MOVD      EAX,XMM0
    3454 
    3455 {$IFDEF FPC}
    3456         JMP @2
    3457 {$ELSE}
    3458         RET
    3459 {$ENDIF}
    3460 @1:     MOV       EAX,EDX
    3461 @2:
    3462 {$ENDIF}
    3463 
    3464 {$IFDEF TARGET_X64}
    3465         TEST      ECX,$FF000000   // foreground completely transparent =>
    3466         JZ        @1              // result = background
    3467         MOV       EAX,ECX         //  EAX  <-  Fa
    3468         CMP       EAX,$FF000000   // foreground completely opaque =>
    3469         JNC       @2              // result = foreground
    3470         TEST      EDX,$FF000000   // background completely transparent =>
    3471         JZ        @2              // result = foreground
    3472 
    3473         PXOR      XMM7,XMM7       // XMM7  <-  00
    3474         MOVD      XMM0,EAX        // XMM0  <-  Fa Fr Fg Fb
    3475         SHR       EAX,24          //  EAX  <-  Fa
    3476         ROR       EDX,24
    3477         MOVZX     ECX,DL          //  ECX  <-  Ba
    3478         PUNPCKLBW XMM0,XMM7       // XMM0  <-  00 Fa 00 Fr 00 Fg 00 Fb
    3479         SUB       EAX,$FF         //  EAX  <-  (Fa - 1)
    3480         XOR       ECX,$FF         //  ECX  <-  (1 - Ba)
    3481         IMUL      ECX,EAX         //  ECX  <-  (Fa - 1) * (1 - Ba)  =  Ra - 1
    3482         IMUL      ECX,$8081       //  ECX  <-  Xa 00 00 00
    3483         ADD       ECX,$8081*$FF*$FF
    3484         SHR       ECX,15          //  ECX  <-  Ra
    3485         MOV       DL,CH           //  EDX  <-  Br Bg Bb Ra
    3486         ROR       EDX,8           //  EDX  <-  Ra Br Bg Bb
    3487         MOVD      XMM1,EDX        // XMM1  <-  Ra Br Bg Bb
    3488         PUNPCKLBW XMM1,XMM7       // XMM1  <-  00 Ra 00 Br 00 Bg 00 Bb
    3489         SHL       EAX,20          //  EAX  <-  Fa 00 00
    3490         PSUBW     XMM0,XMM1       // XMM0  <-  ** Da ** Dr ** Dg ** Db
    3491         ADD       EAX,$0FF01000
    3492         PSLLW     XMM0,4
    3493         XOR       EDX,EDX         //  EDX  <-  00
    3494         DIV       ECX             //  EAX  <-  Fa / Ra  =  Wa
    3495         MOVD      XMM4,EAX        // XMM3  <-  Wa
    3496         PSHUFLW   XMM4,XMM4,$C0   // XMM3  <-  00 00 ** Wa ** Wa ** Wa
    3497         PMULHW    XMM0,XMM4       // XMM0  <-  00 00 ** Pr ** Pg ** Pb
    3498         PADDW     XMM0,XMM1       // XMM0  <-  00 Ra 00 Rr 00 Rg 00 Rb
    3499         PACKUSWB  XMM0,XMM7       // XMM0  <-  Ra Rr Rg Rb
    3500         MOVD      EAX,XMM0
    3501 
    3502 {$IFDEF FPC}
    3503         JMP @2
    3504 {$ELSE}
    3505         RET
    3506 {$ENDIF}
    3507 @1:     MOV       EAX,EDX
    3508 @2:
    3509 {$ENDIF}
    3510 end;
    3511 
    3512 procedure EMMS_SSE2;
    3513 asm
    3514 end;
    3515 
    3516 
    3517 function LightenReg_SSE2(C: TColor32; Amount: Integer): TColor32;
    3518 asm
    3519 {$IFDEF TARGET_X86}
    3520         MOVD    XMM0,EAX
    3521         TEST    EDX,EDX
    3522         JL      @1
    3523         IMUL    EDX,$010101
    3524         MOVD    XMM1,EDX
    3525         PADDUSB XMM0,XMM1
    3526         MOVD    EAX,XMM0
    3527         RET
    3528 @1:     NEG     EDX
    3529         IMUL    EDX,$010101
    3530         MOVD    XMM1,EDX
    3531         PSUBUSB XMM0,XMM1
    3532         MOVD    EAX,XMM0
    3533 {$ENDIF}
    3534 
    3535 {$IFDEF TARGET_X64}
    3536         MOVD    XMM0,ECX
    3537         TEST    EDX,EDX
    3538         JL      @1
    3539         IMUL    EDX,$010101
    3540         MOVD    XMM1,EDX
    3541         PADDUSB XMM0,XMM1
    3542         MOVD    EAX,XMM0
    3543         RET
    3544 @1:     NEG     EDX
    3545         IMUL    EDX,$010101
    3546         MOVD    XMM1,EDX
    3547         PSUBUSB XMM0,XMM1
    3548         MOVD    EAX,XMM0
    3549 {$ENDIF}
    3550 end;
    3551 
    3552 
    3553 { SSE2 Color algebra}
    3554 
    3555 function ColorAdd_SSE2(C1, C2: TColor32): TColor32;
    3556 asm
    3557 {$IFDEF TARGET_X86}
    3558         MOVD      XMM0,EAX
    3559         MOVD      XMM1,EDX
    3560         PADDUSB   XMM0,XMM1
    3561         MOVD      EAX,XMM0
    3562 {$ENDIF}
    3563 
    3564 {$IFDEF TARGET_X64}
    3565         MOVD      XMM0,ECX
    3566         MOVD      XMM1,EDX
    3567         PADDUSB   XMM0,XMM1
    3568         MOVD      EAX,XMM0
    3569 {$ENDIF}
    3570 end;
    3571 
    3572 function ColorSub_SSE2(C1, C2: TColor32): TColor32;
    3573 asm
    3574 {$IFDEF TARGET_X86}
    3575         MOVD      XMM0,EAX
    3576         MOVD      XMM1,EDX
    3577         PSUBUSB   XMM0,XMM1
    3578         MOVD      EAX,XMM0
    3579 {$ENDIF}
    3580 
    3581 {$IFDEF TARGET_X64}
    3582         MOVD      XMM0,ECX
    3583         MOVD      XMM1,EDX
    3584         PSUBUSB   XMM0,XMM1
    3585         MOVD      EAX,XMM0
    3586 {$ENDIF}
    3587 end;
    3588 
    3589 function ColorModulate_SSE2(C1, C2: TColor32): TColor32;
    3590 asm
    3591 {$IFDEF TARGET_X86}
    3592         PXOR      XMM2,XMM2
    3593         MOVD      XMM0,EAX
    3594         PUNPCKLBW XMM0,XMM2
    3595         MOVD      XMM1,EDX
    3596         PUNPCKLBW XMM1,XMM2
    3597         PMULLW    XMM0,XMM1
    3598         PSRLW     XMM0,8
    3599         PACKUSWB  XMM0,XMM2
    3600         MOVD      EAX,XMM0
    3601 {$ENDIF}
    3602 
    3603 {$IFDEF TARGET_X64}
    3604         PXOR      XMM2,XMM2
    3605         MOVD      XMM0,ECX
    3606         PUNPCKLBW XMM0,XMM2
    3607         MOVD      XMM1,EDX
    3608         PUNPCKLBW XMM1,XMM2
    3609         PMULLW    XMM0,XMM1
    3610         PSRLW     XMM0,8
    3611         PACKUSWB  XMM0,XMM2
    3612         MOVD      EAX,XMM0
    3613 {$ENDIF}
    3614 end;
    3615 
    3616 function ColorMax_SSE2(C1, C2: TColor32): TColor32;
    3617 asm
    3618 {$IFDEF TARGET_X86}
    3619         MOVD      XMM0,EAX
    3620         MOVD      XMM1,EDX
    3621         PMAXUB    XMM0,XMM1
    3622         MOVD      EAX,XMM0
    3623 {$ENDIF}
    3624 
    3625 {$IFDEF TARGET_X64}
    3626         MOVD      XMM0,ECX
    3627         MOVD      XMM1,EDX
    3628         PMAXUB    XMM0,XMM1
    3629         MOVD      EAX,XMM0
    3630 {$ENDIF}
    3631 end;
    3632 
    3633 function ColorMin_SSE2(C1, C2: TColor32): TColor32;
    3634 asm
    3635 {$IFDEF TARGET_X86}
    3636         MOVD      XMM0,EAX
    3637         MOVD      XMM1,EDX
    3638         PMINUB    XMM0,XMM1
    3639         MOVD      EAX,XMM0
    3640 {$ENDIF}
    3641 
    3642 {$IFDEF TARGET_X64}
    3643         MOVD      XMM0,ECX
    3644         MOVD      XMM1,EDX
    3645         PMINUB    XMM0,XMM1
    3646         MOVD      EAX,XMM0
    3647 {$ENDIF}
    3648 end;
    3649 
    3650 function ColorDifference_SSE2(C1, C2: TColor32): TColor32;
    3651 asm
    3652 {$IFDEF TARGET_X86}
    3653         MOVD      XMM0,EAX
    3654         MOVD      XMM1,EDX
    3655         MOVQ      XMM2,XMM0
    3656         PSUBUSB   XMM0,XMM1
    3657         PSUBUSB   XMM1,XMM2
    3658         POR       XMM0,XMM1
    3659         MOVD      EAX,XMM0
    3660 {$ENDIF}
    3661 
    3662 {$IFDEF TARGET_X64}
    3663         MOVD      XMM0,ECX
    3664         MOVD      XMM1,EDX
    3665         MOVQ      XMM2,XMM0
    3666         PSUBUSB   XMM0,XMM1
    3667         PSUBUSB   XMM1,XMM2
    3668         POR       XMM0,XMM1
    3669         MOVD      EAX,XMM0
    3670 {$ENDIF}
    3671 end;
    3672 
    3673 function ColorExclusion_SSE2(C1, C2: TColor32): TColor32;
    3674 asm
    3675 {$IFDEF TARGET_X86}
    3676         PXOR      XMM2,XMM2
    3677         MOVD      XMM0,EAX
    3678         PUNPCKLBW XMM0,XMM2
    3679         MOVD      XMM1,EDX
    3680         PUNPCKLBW XMM1,XMM2
    3681         MOVQ      XMM3,XMM0
    3682         PADDW     XMM0,XMM1
    3683         PMULLW    XMM1,XMM3
    3684         PSRLW     XMM1,7
    3685         PSUBUSW   XMM0,XMM1
    3686         PACKUSWB  XMM0,XMM2
    3687         MOVD      EAX,XMM0
    3688 {$ENDIF}
    3689 
    3690 {$IFDEF TARGET_X64}
    3691         PXOR      XMM2,XMM2
    3692         MOVD      XMM0,ECX
    3693         PUNPCKLBW XMM0,XMM2
    3694         MOVD      XMM1,EDX
    3695         PUNPCKLBW XMM1,XMM2
    3696         MOVQ      XMM3,XMM0
    3697         PADDW     XMM0,XMM1
    3698         PMULLW    XMM1,XMM3
    3699         PSRLW     XMM1,7
    3700         PSUBUSW   XMM0,XMM1
    3701         PACKUSWB  XMM0,XMM2
    3702         MOVD      EAX,XMM0
    3703 {$ENDIF}
    3704 end;
    3705 
    3706 function ColorScale_SSE2(C, W: TColor32): TColor32;
    3707 asm
    3708 {$IFDEF TARGET_X86}
    3709         PXOR      XMM2,XMM2
    3710         SHL       EDX,4
    3711         MOVD      XMM0,EAX
    3712         PUNPCKLBW XMM0,XMM2
    3713         ADD       EDX,alpha_ptr
    3714         PMULLW    XMM0,[EDX]
    3715         PSRLW     XMM0,8
    3716         PACKUSWB  XMM0,XMM2
    3717         MOVD      EAX,XMM0
    3718 {$ENDIF}
    3719 
    3720 {$IFDEF TARGET_X64}
    3721         PXOR      XMM2,XMM2
    3722         SHL       RDX,4
    3723         MOVD      XMM0,ECX
    3724         PUNPCKLBW XMM0,XMM2
    3725         ADD       RDX,alpha_ptr
    3726         PMULLW    XMM0,[RDX]
    3727         PSRLW     XMM0,8
    3728         PACKUSWB  XMM0,XMM2
    3729         MOVD      EAX,XMM0
    3730 {$ENDIF}
    3731 end;
    3732 
    3733 {$ENDIF}
    3734897{$ENDIF}
    3735898
     
    3744907var
    3745908  I, J: Integer;
    3746 const
    3747   OneByteth : Double = 1 / 255;
    3748909begin
    3749910  for J := 0 to 255 do
    3750     for I := 0 to 255 do
     911  begin
     912    DivTable[0, J] := 0;
     913    RcTable[0, J] := 0;
     914  end;
     915  for J := 0 to 255 do
     916    for I := 1 to 255 do
    3751917    begin
    3752       DivTable[I, J] := Round(I * J * OneByteth);
    3753       if I > 0 then
    3754         RcTable[I, J] := Round(J * 255 / I)
    3755       else
    3756         RcTable[I, J] := 0;
     918      DivTable[I, J] := Round(I * J * COne255th);
     919      RcTable[I, J] := Round(J * 255 / I)
    3757920    end;
    3758921end;
     
    3763926  FID_MERGEMEM = 2;
    3764927  FID_MERGELINE = 3;
    3765   FID_MERGEREGEX = 4;
    3766   FID_MERGEMEMEX = 5;
    3767   FID_MERGELINEEX = 6;
    3768   FID_COMBINEREG = 7;
    3769   FID_COMBINEMEM = 8;
    3770   FID_COMBINELINE = 9;
    3771 
    3772   FID_BLENDREG = 10;
    3773   FID_BLENDMEM = 11;
    3774   FID_BLENDLINE = 12;
    3775   FID_BLENDREGEX = 13;
    3776   FID_BLENDMEMEX = 14;
    3777   FID_BLENDLINEEX = 15;
    3778 
    3779   FID_COLORMAX = 16;
    3780   FID_COLORMIN = 17;
    3781   FID_COLORAVERAGE = 18;
    3782   FID_COLORADD = 19;
    3783   FID_COLORSUB = 20;
    3784   FID_COLORDIV = 21;
    3785   FID_COLORMODULATE = 22;
    3786   FID_COLORDIFFERENCE = 23;
    3787   FID_COLOREXCLUSION = 24;
    3788   FID_COLORSCALE = 25;
    3789   FID_Lighten = 26;
     928  FID_MERGELINE1 = 4;
     929  FID_MERGEREGEX = 5;
     930  FID_MERGEMEMEX = 6;
     931  FID_MERGELINEEX = 7;
     932  FID_COMBINEREG = 8;
     933  FID_COMBINEMEM = 9;
     934  FID_COMBINELINE = 10;
     935
     936  FID_BLENDREG = 11;
     937  FID_BLENDMEM = 12;
     938  FID_BLENDMEMS = 13;
     939  FID_BLENDLINE = 14;
     940  FID_BLENDREGEX = 15;
     941  FID_BLENDMEMEX = 16;
     942  FID_BLENDLINEEX = 17;
     943  FID_BLENDLINE1 = 18;
     944
     945  FID_COLORMAX = 19;
     946  FID_COLORMIN = 20;
     947  FID_COLORAVERAGE = 21;
     948  FID_COLORADD = 22;
     949  FID_COLORSUB = 23;
     950  FID_COLORDIV = 24;
     951  FID_COLORMODULATE = 25;
     952  FID_COLORDIFFERENCE = 26;
     953  FID_COLOREXCLUSION = 27;
     954  FID_COLORSCALE = 28;
     955  FID_COLORSCREEN = 29;
     956  FID_COLORDODGE = 30;
     957  FID_COLORBURN = 31;
     958  FID_BLENDCOLORADD = 32;
     959  FID_BLENDCOLORMODULATE = 33;
     960  FID_LIGHTEN = 34;
     961
     962  FID_BLENDREGRGB = 35;
     963  FID_BLENDMEMRGB = 36;
     964{$IFDEF TEST_BLENDMEMRGB128SSE4}
     965  FID_BLENDMEMRGB128 = 37;
     966{$ENDIF}
     967
     968const
     969  BlendBindingFlagPascal = $0001;
     970
    3790971
    3791972procedure RegisterBindings;
     
    3807988  BlendRegistry.RegisterBinding(FID_BLENDREG, @@BlendReg);
    3808989  BlendRegistry.RegisterBinding(FID_BLENDMEM, @@BlendMem);
     990  BlendRegistry.RegisterBinding(FID_BLENDMEMS, @@BlendMems);
    3809991  BlendRegistry.RegisterBinding(FID_BLENDLINE, @@BlendLine);
    3810992  BlendRegistry.RegisterBinding(FID_BLENDREGEX, @@BlendRegEx);
    3811993  BlendRegistry.RegisterBinding(FID_BLENDMEMEX, @@BlendMemEx);
    3812994  BlendRegistry.RegisterBinding(FID_BLENDLINEEX, @@BlendLineEx);
     995  BlendRegistry.RegisterBinding(FID_BLENDLINE1, @@BlendLine1);
    3813996
    3814997  BlendRegistry.RegisterBinding(FID_COLORMAX, @@ColorMax);
     
    38221005  BlendRegistry.RegisterBinding(FID_COLOREXCLUSION, @@ColorExclusion);
    38231006  BlendRegistry.RegisterBinding(FID_COLORSCALE, @@ColorScale);
     1007  BlendRegistry.RegisterBinding(FID_COLORSCREEN, @@ColorScreen);
     1008  BlendRegistry.RegisterBinding(FID_COLORDODGE, @@ColorDodge);
     1009  BlendRegistry.RegisterBinding(FID_COLORBURN, @@ColorBurn);
     1010
     1011  BlendRegistry.RegisterBinding(FID_BLENDCOLORADD, @@BlendColorAdd);
     1012  BlendRegistry.RegisterBinding(FID_BLENDCOLORMODULATE, @@BlendColorModulate);
    38241013
    38251014  BlendRegistry.RegisterBinding(FID_LIGHTEN, @@LightenReg);
     1015  BlendRegistry.RegisterBinding(FID_BLENDREGRGB, @@BlendRegRGB);
     1016  BlendRegistry.RegisterBinding(FID_BLENDMEMRGB, @@BlendMemRGB);
     1017{$IFDEF TEST_BLENDMEMRGB128SSE4}
     1018  BlendRegistry.RegisterBinding(FID_BLENDMEMRGB128, @@BlendMemRGB128);
     1019{$ENDIF}
    38261020
    38271021  // pure pascal
    3828   BlendRegistry.Add(FID_EMMS, @EMMS_Pas);
    3829   BlendRegistry.Add(FID_MERGEREG, @MergeReg_Pas);
    3830   BlendRegistry.Add(FID_MERGEMEM, @MergeMem_Pas);
    3831   BlendRegistry.Add(FID_MERGEMEMEX, @MergeMemEx_Pas);
    3832   BlendRegistry.Add(FID_MERGEREGEX, @MergeRegEx_Pas);
    3833   BlendRegistry.Add(FID_MERGELINE, @MergeLine_Pas);
    3834   BlendRegistry.Add(FID_MERGELINEEX, @MergeLineEx_Pas);
    3835   BlendRegistry.Add(FID_COLORDIV, @ColorDiv_Pas);
    3836   BlendRegistry.Add(FID_COLORAVERAGE, @ColorAverage_Pas);
    3837   BlendRegistry.Add(FID_COMBINEREG, @CombineReg_Pas);
    3838   BlendRegistry.Add(FID_COMBINEMEM, @CombineMem_Pas);
    3839   BlendRegistry.Add(FID_COMBINELINE, @CombineLine_Pas);
    3840   BlendRegistry.Add(FID_BLENDREG, @BlendReg_Pas);
    3841   BlendRegistry.Add(FID_BLENDMEM, @BlendMem_Pas);
    3842   BlendRegistry.Add(FID_BLENDLINE, @BlendLine_Pas);
    3843   BlendRegistry.Add(FID_BLENDREGEX, @BlendRegEx_Pas);
    3844   BlendRegistry.Add(FID_BLENDMEMEX, @BlendMemEx_Pas);
    3845   BlendRegistry.Add(FID_BLENDLINEEX, @BlendLineEx_Pas);
    3846   BlendRegistry.Add(FID_COLORMAX, @ColorMax_Pas);
    3847   BlendRegistry.Add(FID_COLORMIN, @ColorMin_Pas);
    3848   BlendRegistry.Add(FID_COLORADD, @ColorAdd_Pas);
    3849   BlendRegistry.Add(FID_COLORSUB, @ColorSub_Pas);
    3850   BlendRegistry.Add(FID_COLORMODULATE, @ColorModulate_Pas);
    3851   BlendRegistry.Add(FID_COLORDIFFERENCE, @ColorDifference_Pas);
    3852   BlendRegistry.Add(FID_COLOREXCLUSION, @ColorExclusion_Pas);
    3853   BlendRegistry.Add(FID_COLORSCALE, @ColorScale_Pas);
    3854   BlendRegistry.Add(FID_LIGHTEN, @LightenReg_Pas);
     1022  BlendRegistry.Add(FID_EMMS, @EMMS_Pas, [], BlendBindingFlagPascal);
     1023  BlendRegistry.Add(FID_MERGEREG, @MergeReg_Pas, [], BlendBindingFlagPascal);
     1024  BlendRegistry.Add(FID_MERGEMEM, @MergeMem_Pas, [], BlendBindingFlagPascal);
     1025  BlendRegistry.Add(FID_MERGEMEMEX, @MergeMemEx_Pas, [], BlendBindingFlagPascal);
     1026  BlendRegistry.Add(FID_MERGEREGEX, @MergeRegEx_Pas, [], BlendBindingFlagPascal);
     1027  BlendRegistry.Add(FID_MERGELINE, @MergeLine_Pas, [], BlendBindingFlagPascal);
     1028  BlendRegistry.Add(FID_MERGELINEEX, @MergeLineEx_Pas, [], BlendBindingFlagPascal);
     1029  BlendRegistry.Add(FID_MERGELINE1, @MergeLine1_Pas, [], BlendBindingFlagPascal);
     1030  BlendRegistry.Add(FID_COLORDIV, @ColorDiv_Pas, [], BlendBindingFlagPascal);
     1031  BlendRegistry.Add(FID_COLORAVERAGE, @ColorAverage_Pas, [], BlendBindingFlagPascal);
     1032  BlendRegistry.Add(FID_COMBINEREG, @CombineReg_Pas, [], BlendBindingFlagPascal);
     1033  BlendRegistry.Add(FID_COMBINEMEM, @CombineMem_Pas, [], BlendBindingFlagPascal);
     1034  BlendRegistry.Add(FID_COMBINELINE, @CombineLine_Pas, [], BlendBindingFlagPascal);
     1035  BlendRegistry.Add(FID_BLENDREG, @BlendReg_Pas, [], BlendBindingFlagPascal);
     1036  BlendRegistry.Add(FID_BLENDMEM, @BlendMem_Pas, [], BlendBindingFlagPascal);
     1037  BlendRegistry.Add(FID_BLENDMEMS, @BlendMems_Pas, [], BlendBindingFlagPascal);
     1038  BlendRegistry.Add(FID_BLENDLINE, @BlendLine_Pas, [], BlendBindingFlagPascal);
     1039  BlendRegistry.Add(FID_BLENDREGEX, @BlendRegEx_Pas, [], BlendBindingFlagPascal);
     1040  BlendRegistry.Add(FID_BLENDMEMEX, @BlendMemEx_Pas, [], BlendBindingFlagPascal);
     1041  BlendRegistry.Add(FID_BLENDLINEEX, @BlendLineEx_Pas, [], BlendBindingFlagPascal);
     1042  BlendRegistry.Add(FID_BLENDLINE1, @BlendLine1_Pas, [], BlendBindingFlagPascal);
     1043  BlendRegistry.Add(FID_COLORMAX, @ColorMax_Pas, [], BlendBindingFlagPascal);
     1044  BlendRegistry.Add(FID_COLORMIN, @ColorMin_Pas, [], BlendBindingFlagPascal);
     1045  BlendRegistry.Add(FID_COLORADD, @ColorAdd_Pas, [], BlendBindingFlagPascal);
     1046  BlendRegistry.Add(FID_COLORSUB, @ColorSub_Pas, [], BlendBindingFlagPascal);
     1047  BlendRegistry.Add(FID_COLORMODULATE, @ColorModulate_Pas, [], BlendBindingFlagPascal);
     1048  BlendRegistry.Add(FID_COLORDIFFERENCE, @ColorDifference_Pas, [], BlendBindingFlagPascal);
     1049  BlendRegistry.Add(FID_COLOREXCLUSION, @ColorExclusion_Pas, [], BlendBindingFlagPascal);
     1050  BlendRegistry.Add(FID_COLORSCALE, @ColorScale_Pas, [], BlendBindingFlagPascal);
     1051  BlendRegistry.Add(FID_COLORSCREEN, @ColorScreen_Pas, [], BlendBindingFlagPascal);
     1052  BlendRegistry.Add(FID_COLORDODGE, @ColorDodge_Pas, [], BlendBindingFlagPascal);
     1053  BlendRegistry.Add(FID_COLORBURN, @ColorBurn_Pas, [], BlendBindingFlagPascal);
     1054  BlendRegistry.Add(FID_BLENDCOLORADD, @BlendColorAdd_Pas, [], BlendBindingFlagPascal);
     1055  BlendRegistry.Add(FID_BLENDCOLORMODULATE, @BlendColorModulate_Pas, [], BlendBindingFlagPascal);
     1056  BlendRegistry.Add(FID_LIGHTEN, @LightenReg_Pas, [], BlendBindingFlagPascal);
     1057  BlendRegistry.Add(FID_BLENDREGRGB, @BlendRegRGB_Pas, [], BlendBindingFlagPascal);
     1058  BlendRegistry.Add(FID_BLENDMEMRGB, @BlendMemRGB_Pas, [], BlendBindingFlagPascal);
    38551059
    38561060{$IFNDEF PUREPASCAL}
     
    38601064  BlendRegistry.Add(FID_BLENDREG, @BlendReg_ASM, []);
    38611065  BlendRegistry.Add(FID_BLENDMEM, @BlendMem_ASM, []);
     1066  BlendRegistry.Add(FID_BLENDMEMS, @BlendMems_ASM, []);
    38621067  BlendRegistry.Add(FID_BLENDREGEX, @BlendRegEx_ASM, []);
    38631068  BlendRegistry.Add(FID_BLENDMEMEX, @BlendMemEx_ASM, []);
    38641069  BlendRegistry.Add(FID_BLENDLINE, @BlendLine_ASM, []);
    3865   BlendRegistry.Add(FID_LIGHTEN, @LightenReg_Pas, []);   // no ASM version available
     1070  BlendRegistry.Add(FID_BLENDLINE1, @BlendLine1_ASM, []);
     1071{$IFNDEF TARGET_x64}
     1072  BlendRegistry.Add(FID_MERGEREG, @MergeReg_ASM, []);
     1073{$ENDIF}
    38661074{$IFNDEF OMIT_MMX}
    38671075  BlendRegistry.Add(FID_EMMS, @EMMS_MMX, [ciMMX]);
     
    38841092  BlendRegistry.Add(FID_COLORSCALE, @ColorScale_MMX, [ciMMX]);
    38851093  BlendRegistry.Add(FID_LIGHTEN, @LightenReg_MMX, [ciMMX]);
     1094  BlendRegistry.Add(FID_BLENDREGRGB, @BlendRegRGB_MMX, [ciMMX]);
     1095  BlendRegistry.Add(FID_BLENDMEMRGB, @BlendMemRGB_MMX, [ciMMX]);
    38861096{$ENDIF}
    38871097{$IFNDEF OMIT_SSE2}
     
    38931103  BlendRegistry.Add(FID_BLENDREG, @BlendReg_SSE2, [ciSSE2]);
    38941104  BlendRegistry.Add(FID_BLENDMEM, @BlendMem_SSE2, [ciSSE2]);
     1105  BlendRegistry.Add(FID_BLENDMEMS, @BlendMems_SSE2, [ciSSE2]);
    38951106  BlendRegistry.Add(FID_BLENDMEMEX, @BlendMemEx_SSE2, [ciSSE2]);
    38961107  BlendRegistry.Add(FID_BLENDLINE, @BlendLine_SSE2, [ciSSE2]);
     
    39061117  BlendRegistry.Add(FID_COLORSCALE, @ColorScale_SSE2, [ciSSE2]);
    39071118  BlendRegistry.Add(FID_LIGHTEN, @LightenReg_SSE2, [ciSSE]);
    3908 {$ENDIF}
    3909 {$IFNDEF TARGET_x64}
    3910   BlendRegistry.Add(FID_MERGEREG, @MergeReg_ASM, []);
     1119  BlendRegistry.Add(FID_BLENDREGRGB, @BlendRegRGB_SSE2, [ciSSE2]);
     1120  BlendRegistry.Add(FID_BLENDMEMRGB, @BlendMemRGB_SSE2, [ciSSE2]);
     1121{$IFDEF TEST_BLENDMEMRGB128SSE4}
     1122  BlendRegistry.Add(FID_BLENDMEMRGB128, @BlendMemRGB128_SSE4, [ciSSE2]);
     1123{$ENDIF}
    39111124{$ENDIF}
    39121125{$ENDIF}
     
    39161129
    39171130initialization
     1131  BlendColorAdd := BlendColorAdd_Pas;
     1132
    39181133  RegisterBindings;
    39191134  MakeMergeTables;
     
    39291144finalization
    39301145{$IFNDEF PUREPASCAL}
    3931 {$IFNDEF OMIT_MMX}
    3932   if (ciMMX in CPUFeatures) then FreeAlphaTable;
    3933 {$ENDIF}
     1146  if [ciMMX, ciSSE2] * CPUFeatures <> [] then
     1147    FreeAlphaTable;
    39341148{$ENDIF}
    39351149
  • GraphicTest/Packages/Graphics32/GR32_Compiler.inc

    r450 r522  
    4949    COMPILERXE1  - Delphi XE
    5050    COMPILERXE2  - Delphi XE2
     51    COMPILERXE3  - Delphi XE3
     52    COMPILERXE4  - Delphi XE4
     53    COMPILERXE5  - Delphi XE5
     54    COMPILERXE6  - Delphi XE6
     55    COMPILERXE7  - Delphi XE7
     56    COMPILERXE8  - Delphi XE8
     57    COMPILERRX   - Delphi RX
     58    COMPILERRX1  - Delphi RX1
     59          COMPILERRX2  - Delphi RX2 (10.2 Tokyo)
     60    COMPILERRX3  - Delphi RX3 (10.3 Rio)
    5161
    5262
     
    6676{$ENDIF}
    6777
     78{$IFDEF VER_LATEST} // adjust for newer version (always use latest version)
     79  {$DEFINE COMPILERRX3}
     80  {$IFNDEF BCB}
     81    {$DEFINE DELPHIRX3}
     82  {$ELSE}
     83    {$DEFINE BCBRX3}
     84  {$ENDIF}
     85  {$UNDEF VER_LATEST}
     86{$ENDIF}
     87
     88{$IFDEF VER330}
     89  {$DEFINE COMPILERRX3}
     90  {$IFNDEF BCB}
     91    {$DEFINE DELPHIRX3}
     92  {$ELSE}
     93    {$DEFINE BCBRX3}
     94  {$ENDIF}
     95{$ENDIF}
     96
     97{$IFDEF VER320}
     98  {$DEFINE COMPILERRX2}
     99  {$IFNDEF BCB}
     100    {$DEFINE DELPHIRX2}
     101  {$ELSE}
     102    {$DEFINE BCBRX2}
     103  {$ENDIF}
     104{$ENDIF}
     105
     106{$IFDEF VER310}
     107  {$DEFINE COMPILERRX1}
     108  {$IFNDEF BCB}
     109    {$DEFINE DELPHIRX1}
     110  {$ELSE}
     111    {$DEFINE BCBRX1}
     112  {$ENDIF}
     113{$ENDIF}
     114
     115{$IFDEF VER300}
     116  {$DEFINE COMPILERRX}
     117  {$IFNDEF BCB}
     118    {$DEFINE DELPHIRX}
     119  {$ELSE}
     120    {$DEFINE BCBRX}
     121  {$ENDIF}
     122{$ENDIF}
     123
     124{$IFDEF VER290}
     125  {$DEFINE COMPILERXE8}
     126  {$IFNDEF BCB}
     127    {$DEFINE DELPHIXE8}
     128  {$ELSE}
     129    {$DEFINE BCBXE8}
     130  {$ENDIF}
     131{$ENDIF}
     132
     133{$IFDEF VER280}
     134  {$DEFINE COMPILERXE7}
     135  {$IFNDEF BCB}
     136    {$DEFINE DELPHIXE7}
     137  {$ELSE}
     138    {$DEFINE BCBXE7}
     139  {$ENDIF}
     140{$ENDIF}
     141
     142{$IFDEF VER270}
     143  {$DEFINE COMPILERXE6}
     144  {$IFNDEF BCB}
     145    {$DEFINE DELPHIXE6}
     146  {$ELSE}
     147    {$DEFINE BCBXE6}
     148  {$ENDIF}
     149{$ENDIF}
     150
     151{$IFDEF VER260}
     152  {$DEFINE COMPILERXE5}
     153  {$IFNDEF BCB}
     154    {$DEFINE DELPHIXE5}
     155  {$ELSE}
     156    {$DEFINE BCBXE5}
     157  {$ENDIF}
     158{$ENDIF}
     159
     160{$IFDEF VER250}
     161  {$DEFINE COMPILERXE4}
     162  {$IFNDEF BCB}
     163    {$DEFINE DELPHIXE4}
     164  {$ELSE}
     165    {$DEFINE BCBXE4}
     166  {$ENDIF}
     167{$ENDIF}
     168
     169{$IFDEF VER240}
     170  {$DEFINE COMPILERXE3}
     171  {$IFNDEF BCB}
     172    {$DEFINE DELPHIXE3}
     173  {$ELSE}
     174    {$DEFINE BCBXE3}
     175  {$ENDIF}
     176{$ENDIF}
     177
    68178{$IFDEF VER230}
    69179  {$DEFINE COMPILERXE2}
    70180  {$IFNDEF BCB}
    71     {$DEFINE DELPHIXE1}
    72181    {$DEFINE DELPHIXE2}
    73182  {$ELSE}
    74     {$DEFINE BCB7}
     183    {$DEFINE BCBXE2}
    75184  {$ENDIF}
    76185{$ENDIF}
     
    81190    {$DEFINE DELPHIXE1}
    82191  {$ELSE}
    83     {$DEFINE BCB7}
     192    {$DEFINE BCBXE1}
    84193  {$ENDIF}
    85194{$ENDIF}
     
    90199    {$DEFINE DELPHI2010}
    91200  {$ELSE}
    92     {$DEFINE BCB7}
     201    {$DEFINE BCB14}
    93202  {$ENDIF}
    94203{$ENDIF}
     
    99208    {$DEFINE DELPHI2009}
    100209  {$ELSE}
    101     {$DEFINE BCB7}
     210    {$DEFINE BCB12}
    102211  {$ENDIF}
    103212{$ENDIF}
     
    108217    {$DEFINE DELPHI2007}
    109218  {$ELSE}
    110     {$DEFINE BCB7}
     219    {$DEFINE BCB11}
    111220  {$ENDIF}
    112221{$ENDIF}
     
    117226    {$DEFINE DELPHI2006}
    118227  {$ELSE}
    119     {$DEFINE BCB7}
     228    {$DEFINE BCB10}
    120229  {$ENDIF}
    121230{$ENDIF}
     
    126235    {$DEFINE DELPHI2005}
    127236  {$ELSE}
    128     {$DEFINE BCB7}
     237    {$DEFINE BCB8}
    129238  {$ENDIF}
    130239{$ENDIF}
     
    146255    {$DEFINE BCB6}
    147256  {$ENDIF}
     257{$ENDIF}
     258
     259{$IFDEF COMPILERRX3}
     260  {$DEFINE COMPILERRX3_UP}
     261  {$DEFINE COMPILERRX2_UP}
     262  {$DEFINE COMPILERRX1_UP}
     263  {$DEFINE COMPILERRX_UP}
     264  {$DEFINE COMPILERXE8_UP}
     265  {$DEFINE COMPILERXE7_UP}
     266  {$DEFINE COMPILERXE6_UP}
     267  {$DEFINE COMPILERXE5_UP}
     268  {$DEFINE COMPILERXE4_UP}
     269  {$DEFINE COMPILERXE3_UP}
     270  {$DEFINE COMPILERXE2_UP}
     271  {$DEFINE COMPILERXE1_UP}
     272  {$DEFINE COMPILER2010_UP}
     273  {$DEFINE COMPILER2009_UP}
     274  {$DEFINE COMPILER2007_UP}
     275  {$DEFINE COMPILER2006_UP}
     276  {$DEFINE COMPILER2005_UP}
     277  {$DEFINE COMPILER7_UP}
     278  {$DEFINE COMPILER6_UP}
     279{$ENDIF}
     280
     281{$IFDEF COMPILERRX2}
     282  {$DEFINE COMPILERRX2_UP}
     283  {$DEFINE COMPILERRX1_UP}
     284  {$DEFINE COMPILERRX_UP}
     285  {$DEFINE COMPILERXE8_UP}
     286  {$DEFINE COMPILERXE7_UP}
     287  {$DEFINE COMPILERXE6_UP}
     288  {$DEFINE COMPILERXE5_UP}
     289  {$DEFINE COMPILERXE4_UP}
     290  {$DEFINE COMPILERXE3_UP}
     291  {$DEFINE COMPILERXE2_UP}
     292  {$DEFINE COMPILERXE1_UP}
     293  {$DEFINE COMPILER2010_UP}
     294  {$DEFINE COMPILER2009_UP}
     295  {$DEFINE COMPILER2007_UP}
     296  {$DEFINE COMPILER2006_UP}
     297  {$DEFINE COMPILER2005_UP}
     298  {$DEFINE COMPILER7_UP}
     299  {$DEFINE COMPILER6_UP}
     300{$ENDIF}
     301
     302{$IFDEF COMPILERRX1}
     303  {$DEFINE COMPILERRX1_UP}
     304  {$DEFINE COMPILERRX_UP}
     305  {$DEFINE COMPILERXE8_UP}
     306  {$DEFINE COMPILERXE7_UP}
     307  {$DEFINE COMPILERXE6_UP}
     308  {$DEFINE COMPILERXE5_UP}
     309  {$DEFINE COMPILERXE4_UP}
     310  {$DEFINE COMPILERXE3_UP}
     311  {$DEFINE COMPILERXE2_UP}
     312  {$DEFINE COMPILERXE1_UP}
     313  {$DEFINE COMPILER2010_UP}
     314  {$DEFINE COMPILER2009_UP}
     315  {$DEFINE COMPILER2007_UP}
     316  {$DEFINE COMPILER2006_UP}
     317  {$DEFINE COMPILER2005_UP}
     318  {$DEFINE COMPILER7_UP}
     319  {$DEFINE COMPILER6_UP}
     320{$ENDIF}
     321
     322{$IFDEF COMPILERRX}
     323  {$DEFINE COMPILERRX_UP}
     324  {$DEFINE COMPILERXE8_UP}
     325  {$DEFINE COMPILERXE7_UP}
     326  {$DEFINE COMPILERXE6_UP}
     327  {$DEFINE COMPILERXE5_UP}
     328  {$DEFINE COMPILERXE4_UP}
     329  {$DEFINE COMPILERXE3_UP}
     330  {$DEFINE COMPILERXE2_UP}
     331  {$DEFINE COMPILERXE1_UP}
     332  {$DEFINE COMPILER2010_UP}
     333  {$DEFINE COMPILER2009_UP}
     334  {$DEFINE COMPILER2007_UP}
     335  {$DEFINE COMPILER2006_UP}
     336  {$DEFINE COMPILER2005_UP}
     337  {$DEFINE COMPILER7_UP}
     338  {$DEFINE COMPILER6_UP}
     339{$ENDIF}
     340
     341{$IFDEF COMPILERXE8}
     342  {$DEFINE COMPILERXE8_UP}
     343  {$DEFINE COMPILERXE7_UP}
     344  {$DEFINE COMPILERXE6_UP}
     345  {$DEFINE COMPILERXE5_UP}
     346  {$DEFINE COMPILERXE4_UP}
     347  {$DEFINE COMPILERXE3_UP}
     348  {$DEFINE COMPILERXE2_UP}
     349  {$DEFINE COMPILERXE1_UP}
     350  {$DEFINE COMPILER2010_UP}
     351  {$DEFINE COMPILER2009_UP}
     352  {$DEFINE COMPILER2007_UP}
     353  {$DEFINE COMPILER2006_UP}
     354  {$DEFINE COMPILER2005_UP}
     355  {$DEFINE COMPILER7_UP}
     356  {$DEFINE COMPILER6_UP}
     357{$ENDIF}
     358
     359{$IFDEF COMPILERXE7}
     360  {$DEFINE COMPILERXE7_UP}
     361  {$DEFINE COMPILERXE6_UP}
     362  {$DEFINE COMPILERXE5_UP}
     363  {$DEFINE COMPILERXE4_UP}
     364  {$DEFINE COMPILERXE3_UP}
     365  {$DEFINE COMPILERXE2_UP}
     366  {$DEFINE COMPILERXE1_UP}
     367  {$DEFINE COMPILER2010_UP}
     368  {$DEFINE COMPILER2009_UP}
     369  {$DEFINE COMPILER2007_UP}
     370  {$DEFINE COMPILER2006_UP}
     371  {$DEFINE COMPILER2005_UP}
     372  {$DEFINE COMPILER7_UP}
     373  {$DEFINE COMPILER6_UP}
     374{$ENDIF}
     375
     376{$IFDEF COMPILERXE6}
     377  {$DEFINE COMPILERXE6_UP}
     378  {$DEFINE COMPILERXE5_UP}
     379  {$DEFINE COMPILERXE4_UP}
     380  {$DEFINE COMPILERXE3_UP}
     381  {$DEFINE COMPILERXE2_UP}
     382  {$DEFINE COMPILERXE1_UP}
     383  {$DEFINE COMPILER2010_UP}
     384  {$DEFINE COMPILER2009_UP}
     385  {$DEFINE COMPILER2007_UP}
     386  {$DEFINE COMPILER2006_UP}
     387  {$DEFINE COMPILER2005_UP}
     388  {$DEFINE COMPILER7_UP}
     389  {$DEFINE COMPILER6_UP}
     390{$ENDIF}
     391
     392{$IFDEF COMPILERXE5}
     393  {$DEFINE COMPILERXE5_UP}
     394  {$DEFINE COMPILERXE4_UP}
     395  {$DEFINE COMPILERXE3_UP}
     396  {$DEFINE COMPILERXE2_UP}
     397  {$DEFINE COMPILERXE1_UP}
     398  {$DEFINE COMPILER2010_UP}
     399  {$DEFINE COMPILER2009_UP}
     400  {$DEFINE COMPILER2007_UP}
     401  {$DEFINE COMPILER2006_UP}
     402  {$DEFINE COMPILER2005_UP}
     403  {$DEFINE COMPILER7_UP}
     404  {$DEFINE COMPILER6_UP}
     405{$ENDIF}
     406
     407{$IFDEF COMPILERXE4}
     408  {$DEFINE COMPILERXE4_UP}
     409  {$DEFINE COMPILERXE3_UP}
     410  {$DEFINE COMPILERXE2_UP}
     411  {$DEFINE COMPILERXE1_UP}
     412  {$DEFINE COMPILER2010_UP}
     413  {$DEFINE COMPILER2009_UP}
     414  {$DEFINE COMPILER2007_UP}
     415  {$DEFINE COMPILER2006_UP}
     416  {$DEFINE COMPILER2005_UP}
     417  {$DEFINE COMPILER7_UP}
     418  {$DEFINE COMPILER6_UP}
     419{$ENDIF}
     420
     421{$IFDEF COMPILERXE3}
     422  {$DEFINE COMPILERXE3_UP}
     423  {$DEFINE COMPILERXE2_UP}
     424  {$DEFINE COMPILERXE1_UP}
     425  {$DEFINE COMPILER2010_UP}
     426  {$DEFINE COMPILER2009_UP}
     427  {$DEFINE COMPILER2007_UP}
     428  {$DEFINE COMPILER2006_UP}
     429  {$DEFINE COMPILER2005_UP}
     430  {$DEFINE COMPILER7_UP}
     431  {$DEFINE COMPILER6_UP}
    148432{$ENDIF}
    149433
     
    223507  {$DEFINE PLATFORM_INDEPENDENT}
    224508  {$MODE Delphi}
    225   {$ASMMODE INTEL}
    226509{$ENDIF}
    227510
     
    275558      // target is an Intel 80386 or later.
    276559      {$DEFINE TARGET_x86}
     560      {$ASMMODE INTEL}
    277561    {$ENDIF}
    278562
     
    280564      // target is a 64-bit processor (AMD or INTEL).
    281565      {$DEFINE TARGET_x64}
     566      {$ASMMODE INTEL}
    282567    {$ENDIF}
    283568
     
    293578    // target is a 64-bit processor (AMD or INTEL).
    294579    {$DEFINE TARGET_x64}
     580    {$ASMMODE INTEL}
     581  {$ENDIF}
     582
     583  {$IFDEF CPUARM}
     584    // target is an ARM processor.
     585    {$DEFINE TARGET_ARM}
    295586  {$ENDIF}
    296587{$ELSE}
     
    338629
    339630{$IFDEF COMPILERFPC}
    340   {$DEFINE PUREPASCAL}
     631  {-$DEFINE PUREPASCAL}
    341632{$ENDIF}
    342633
    343634{$IFDEF TARGET_x64}
    344635  {-$DEFINE PUREPASCAL}
     636{$ENDIF}
     637
     638{$IFDEF TARGET_ARM}
     639  {$DEFINE PUREPASCAL}
     640  {$DEFINE OMIT_MMX}
     641  {$DEFINE OMIT_SSE2}
    345642{$ENDIF}
    346643
     
    433730{$R-}{$Q-}  // switch off overflow and range checking
    434731
    435 {$IFDEF COMPILER6}
     732{$IFDEF COMPILER6_UP}
    436733  {$DEFINE EXT_PROP_EDIT}
     734{$ENDIF}
     735
     736{$IFDEF COMPILER2005_UP}
     737  {$DEFINE HasParentBackground}
     738{$ENDIF}
     739
     740{$IFDEF COMPILER2010_UP}
     741  {$DEFINE SUPPORT_ENHANCED_RECORDS}
    437742{$ENDIF}
    438743
     
    486791  {$DEFINE COMPILERXE2}
    487792{$ENDIF}
     793
     794{$IFDEF COMPILERXE3_UP}
     795  {$DEFINE COMPILERXE3}
     796{$ENDIF}
     797
     798{$IFDEF COMPILERXE4_UP}
     799  {$DEFINE COMPILERXE4}
     800{$ENDIF}
     801
     802{$IFDEF COMPILERXE5_UP}
     803  {$DEFINE COMPILERXE5}
     804{$ENDIF}
     805
     806{$IFDEF COMPILERXE6_UP}
     807  {$DEFINE COMPILERXE6}
     808{$ENDIF}
     809
     810{$IFDEF COMPILERXE7_UP}
     811  {$DEFINE COMPILERXE7}
     812{$ENDIF}
     813
     814{$IFDEF COMPILERXE8_UP}
     815  {$DEFINE COMPILERXE8}
     816{$ENDIF}
     817
     818{$IFDEF COMPILERRX_UP}
     819  {$DEFINE COMPILERRX8}
     820{$ENDIF}
     821
     822{$IFDEF COMPILERRX1_UP}
     823  {$DEFINE COMPILERRX1}
     824{$ENDIF}
     825
     826{$IFDEF COMPILERRX2_UP}
     827  {$DEFINE COMPILERRX2}
     828{$ENDIF}
  • GraphicTest/Packages/Graphics32/GR32_Containers.pas

    r450 r522  
    4040uses
    4141{$IFDEF FPC}
    42   Types,
    4342  {$IFDEF Windows}
    4443  Windows,
     44  {$ELSE}
     45  Types,
    4546  {$ENDIF}
    4647{$ELSE}
    47   Windows,
     48  Types, Windows,
    4849{$ENDIF}
    4950  RTLConsts,
    50   GR32, SysUtils, GR32_LowLevel, Classes, TypInfo;
     51  GR32, SysUtils, Classes, TypInfo;
    5152
    5253const
     
    180181    function First: TClass;
    181182    function Last: TClass;
    182     function Find(AClassName: string): TClass;
     183    function Find(const AClassName: string): TClass;
    183184    procedure GetClassNames(Strings: TStrings);
    184185    procedure Insert(Index: Integer; AClass: TClass);
     
    231232implementation
    232233
     234uses
     235  GR32_LowLevel;
     236
    233237procedure SmartAssign(Src, Dst: TPersistent; TypeKinds: TTypeKinds = tkProperties);
    234238var
     
    247251    Count := GetPropList(Src.ClassInfo, TypeKinds, Props, False);
    248252
     253    {$IFNDEF NEXTGEN}
    249254    for I := 0 to Count - 1 do
    250255    with Props^[I]^ do
     
    262267        SetPropValue(Dst, string(Name), GetPropValue(Src, string(Name), True));
    263268    end;
     269    {$ENDIF}
    264270  finally
    265271    FreeMem(Props, Count * SizeOf(PPropInfo));
     
    422428  I: Integer;
    423429begin
     430{$IFDEF HAS_NATIVEINT}
     431  BucketIndex := NativeUInt(Item) shr 8 and BUCKET_MASK; // KISS pointer hash(TM)
     432{$ELSE}
    424433  BucketIndex := Cardinal(Item) shr 8 and BUCKET_MASK; // KISS pointer hash(TM)
     434{$ENDIF}
    425435  // due to their randomness, pointers most commonly differ at byte 1, we use
    426436  // this characteristic for our hash and just apply the mask to it.
     
    444454begin
    445455  if not Exists(Item, BucketIndex, ItemIndex) then
     456{$IFDEF FPC}
     457    raise EListError.CreateFmt(SItemNotFound, [Item])
     458{$ELSE}
     459{$IFDEF HAS_NATIVEINT}
     460    raise EListError.CreateFmt(SItemNotFound, [NativeInt(Item)])
     461{$ELSE}
    446462    raise EListError.CreateFmt(SItemNotFound, [Integer(Item)])
     463{$ENDIF}
     464{$ENDIF}
    447465  else
    448466    Result := FBuckets[BucketIndex].Items[ItemIndex].Data;
     
    454472begin
    455473  if not Exists(Item, BucketIndex, ItemIndex) then
     474{$IFDEF FPC}
     475    raise EListError.CreateFmt(SItemNotFound, [Item])
     476{$ELSE}
     477{$IFDEF HAS_NATIVEINT}
     478    raise EListError.CreateFmt(SItemNotFound, [NativeInt(Item)])
     479{$ELSE}
    456480    raise EListError.CreateFmt(SItemNotFound, [Integer(Item)])
     481{$ENDIF}
     482{$ENDIF}
    457483  else
    458484    FBuckets[BucketIndex].Items[ItemIndex].Data := Data;
     
    644670end;
    645671
    646 function TClassList.Find(AClassName: string): TClass;
     672function TClassList.Find(const AClassName: string): TClass;
    647673var
    648674  I: Integer;
  • GraphicTest/Packages/Graphics32/GR32_Dsgn_Bitmap.pas

    r450 r522  
    4343{$ELSE}
    4444  Windows, ExtDlgs, ToolWin, Registry, ImgList, Consts, DesignIntf,
    45 DesignEditors, VCLEditors,
     45  DesignEditors, VCLEditors,
    4646{$ENDIF}
    4747  Forms, Controls, ComCtrls, ExtCtrls, StdCtrls, Graphics, Dialogs, Menus,
     
    373373    BitmapEditor := TBitmap32Editor.Create(nil);
    374374    try
     375      {$IFDEF FPC}
     376      BitmapEditor.Bitmap32 := TBitmap32(GetObjectValue);
     377      {$ELSE}
    375378      BitmapEditor.Bitmap32 := TBitmap32(Pointer(GetOrdValue));
     379      {$ENDIF}
    376380      if BitmapEditor.Execute then
    377381      begin
  • GraphicTest/Packages/Graphics32/GR32_Dsgn_Color.pas

    r450 r522  
    4747  Consts,
    4848  DesignIntf, DesignEditors, VCLEditors,
    49   Windows, Registry, Graphics, Dialogs, Forms,
     49  Windows, Registry, Graphics, Dialogs, Forms, Controls,
    5050{$ENDIF}
    5151  GR32, GR32_Image;
     
    7070    procedure RemoveColor(const AName: string);
    7171  end;
     72
     73{$IFDEF COMPILER2010_UP}
     74  TColor32Dialog = class(TCommonDialog)
     75  private
     76    FColor: TColor32;
     77    FCustomColors: TStrings;
     78    procedure SetCustomColors(Value: TStrings);
     79  public
     80    function Execute(ParentWnd: HWND): Boolean; override;
     81  published
     82    property Color: TColor32 read FColor write FColor default clBlack32;
     83    property CustomColors: TStrings read FCustomColors write SetCustomColors;
     84    property Ctl3D default True;
     85  end;
     86{$ENDIF}
    7287
    7388  { TColor32Property }
     
    106121
    107122implementation
     123
     124{$IFDEF COMPILER2010_UP}
     125uses
     126  GR32_Dsgn_ColorPicker;
     127{$ENDIF}
    108128
    109129{ TColorManager }
     
    387407
    388408
     409{ TColor32Dialog }
     410
     411{$IFDEF COMPILER2010_UP}
     412procedure TColor32Dialog.SetCustomColors(Value: TStrings);
     413begin
     414  FCustomColors.Assign(Value);
     415end;
     416
     417function TColor32Dialog.Execute(ParentWnd: HWND): Boolean;
     418var
     419  ColorPicker: TFormColorPicker;
     420begin
     421  ColorPicker := TFormColorPicker.Create(nil);
     422  try
     423    ColorPicker.Color := FColor;
     424    Result := ColorPicker.ShowModal = mrOK;
     425    if Result then
     426      FColor := ColorPicker.Color;
     427  finally
     428    ColorPicker.Free;
     429  end;
     430end;
     431{$ENDIF}
     432
     433
    389434{ TColor32Property }
    390435
     
    392437procedure TColor32Property.Edit;
    393438var
     439{$IFDEF COMPILER2010_UP}
     440  ColorDialog: TColor32Dialog;
     441{$ELSE}
    394442  ColorDialog: TColorDialog;
     443{$ENDIF}
    395444  IniFile: TRegIniFile;
    396445
     
    427476begin
    428477  IniFile := nil;
     478{$IFDEF COMPILER2010_UP}
     479  ColorDialog := TColor32Dialog.Create(Application);
     480{$ELSE}
    429481  ColorDialog := TColorDialog.Create(Application);
     482{$ENDIF}
    430483  try
    431484    GetCustomColors;
    432     ColorDialog.Color := WinColor(GetOrdValue);
     485    ColorDialog.Color := GetOrdValue;
    433486    ColorDialog.HelpContext := 25010;
     487{$IFNDEF COMPILER2010_UP}
    434488    ColorDialog.Options := [cdShowHelp];
     489{$ENDIF}
    435490    if ColorDialog.Execute then
    436       SetOrdValue(Cardinal(Color32(ColorDialog.Color)));
     491      SetOrdValue(Cardinal(ColorDialog.Color));
    437492    SaveCustomColors;
    438493  finally
     
    446501begin
    447502  Result := [paMultiSelect, {$IFDEF EXT_PROP_EDIT}paDialog,{$ENDIF} paValueList,
    448   paRevertable];
     503    paRevertable];
    449504end;
    450505
  • GraphicTest/Packages/Graphics32/GR32_ExtImage.pas

    r450 r522  
    309309  FDest := Dst;
    310310  FDstRect := DstRect;
    311   Priority := tpNormal;
    312311{$IFDEF USETHREADRESUME}
    313312  if not Suspended then Resume;
  • GraphicTest/Packages/Graphics32/GR32_Filters.pas

    r450 r522  
    5050  Windows,
    5151{$ENDIF}
    52   Classes, SysUtils, GR32, GR32_Blend, GR32_System, GR32_Bindings;
     52  Classes, SysUtils, GR32;
    5353
    5454{ Basic processing }
     
    8383
    8484uses
     85  {$IFDEF COMPILERXE2_UP}Types, {$ENDIF} GR32_System, GR32_Bindings,
    8586  GR32_Lowlevel;
    8687
     
    8990  SEmptySource = 'The source is nil';
    9091  SEmptyDestination = 'Destination is nil';
    91   SNoInPlace = 'In-place operation is not supported here';
    9292
    9393type
     
    115115    (@@LogicalMaskLineOr)
    116116  );
    117  
     117
    118118  LOGICAL_MASK_LINE_EX: array[TLogicalOperator] of ^TLogicalMaskLineEx = (
    119119    (@@LogicalMaskLineXorEx),
     
    181181  with Dst do
    182182  begin
    183     IntersectRect(SrcRect, SrcRect, Src.BoundsRect);
     183    GR32.IntersectRect(SrcRect, SrcRect, Src.BoundsRect);
    184184    if (SrcRect.Right < SrcRect.Left) or (SrcRect.Bottom < SrcRect.Top) then Exit;
    185185
     
    187187    DstY := Clamp(DstY, 0, Height);
    188188
    189     DstRect.TopLeft := Point(DstX, DstY);
     189    DstRect.TopLeft := GR32.Point(DstX, DstY);
    190190    DstRect.Right := DstX + SrcRect.Right - SrcRect.Left;
    191191    DstRect.Bottom := DstY + SrcRect.Bottom - SrcRect.Top;
    192192
    193     IntersectRect(DstRect, DstRect, BoundsRect);
    194     IntersectRect(DstRect, DstRect, ClipRect);
     193    GR32.IntersectRect(DstRect, DstRect, BoundsRect);
     194    GR32.IntersectRect(DstRect, DstRect, ClipRect);
    195195    if (DstRect.Right < DstRect.Left) or (DstRect.Bottom < DstRect.Top) then Exit;
    196196
     
    480480  with Dst do
    481481  begin
    482     IntersectRect(SrcRect, SrcRect, Src.BoundsRect);
     482    GR32.IntersectRect(SrcRect, SrcRect, Src.BoundsRect);
    483483    if (SrcRect.Right < SrcRect.Left) or (SrcRect.Bottom < SrcRect.Top) then Exit;
    484484
     
    486486    DstY := Clamp(DstY, 0, Height);
    487487
    488     DstRect.TopLeft := Point(DstX, DstY);
     488    DstRect.TopLeft := GR32.Point(DstX, DstY);
    489489    DstRect.Right := DstX + SrcRect.Right - SrcRect.Left;
    490490    DstRect.Bottom := DstY + SrcRect.Bottom - SrcRect.Top;
    491491
    492     IntersectRect(DstRect, DstRect, Dst.BoundsRect);
    493     IntersectRect(DstRect, DstRect, Dst.ClipRect);
    494     if (DstRect.Right < DstRect.Left) or (DstRect.Bottom < DstRect.Top) then Exit;
    495 
     492    GR32.IntersectRect(DstRect, DstRect, Dst.BoundsRect);
     493    GR32.IntersectRect(DstRect, DstRect, Dst.ClipRect);
     494    if (DstRect.Right < DstRect.Left) or (DstRect.Bottom < DstRect.Top) then
     495      Exit;
    496496
    497497    if not MeasuringMode then
     
    530530  with ABitmap do
    531531  begin
    532     IntersectRect(ARect, ARect, BoundsRect);
    533     IntersectRect(ARect, ARect, ClipRect);
     532    GR32.IntersectRect(ARect, ARect, BoundsRect);
     533    GR32.IntersectRect(ARect, ARect, ClipRect);
    534534    if (ARect.Right < ARect.Left) or (ARect.Bottom < ARect.Top) then Exit;
    535535
  • GraphicTest/Packages/Graphics32/GR32_Geometry.pas

    r450 r522  
    2727 * Michael Hansen <dyster_tid@hotmail.com>
    2828 *
    29  * Portions created by the Initial Developers are Copyright (C) 2005-2009
     29 * Portions created by the Initial Developers are Copyright (C) 2005-2012
    3030 * the Initial Developers. All Rights Reserved.
    3131 *
     
    3838
    3939uses
    40   Math, GR32, GR32_Math;
     40  Math, Types, GR32;
    4141
    4242type
    43   PFixedVector = ^TFixedVector;
    44   TFixedVector = TFixedPoint;
    45 
    46   PFloatVector = ^TFloatVector;
    47   TFloatVector = TFloatPoint;
    48 
    49 function Add(const V1, V2: TFloatVector): TFloatVector;  overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    50 function Add(const V: TFloatVector; Value: TFloat): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    51 function Sub(const V1, V2: TFloatVector): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    52 function Sub(const V: TFloatVector; Value: TFloat): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    53 function Mul(const V1, V2: TFloatVector): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    54 function Mul(const V: TFloatVector; Multiplier: TFloat): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    55 function Divide(const V: TFloatVector; Divisor: TFloat): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    56 function Divide(const V1, V2: TFloatVector): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    57 
    58 function Combine(const V1, V2: TFloatVector; W: TFloat): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    59 function AbsV(const V: TFloatVector): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    60 function Neg(const V: TFloatVector): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    61 function Average(const V1, V2: TFloatVector): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    62 function Max(const V1, V2: TFloatVector): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    63 function Min(const V1, V2: TFloatVector): TFloatVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    64 
    65 function Dot(const V1, V2: TFloatVector): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    66 function Distance(const V1, V2: TFloatVector): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    67 function SqrDistance(const V1, V2: TFloatVector): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    68 
    69 // Fixed Overloads
    70 function Add(const V1, V2: TFixedVector): TFixedVector;  overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    71 function Add(const V: TFixedVector; Value: TFixed): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    72 function Sub(const V1, V2: TFixedVector): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    73 function Sub(const V: TFixedVector; Value: TFixed): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    74 function Mul(const V1, V2: TFixedVector): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    75 function Mul(const V: TFixedVector; Multiplier: TFixed): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    76 function Divide(const V: TFixedVector; Divisor: TFixed): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    77 function Divide(const V1, V2: TFixedVector): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    78 
    79 function Combine(const V1, V2: TFixedVector; W: TFixed): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    80 function AbsV(const V: TFixedVector): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    81 function Neg(const V: TFixedVector): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    82 function Average(const V1, V2: TFixedVector): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    83 function Max(const V1, V2: TFixedVector): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    84 function Min(const V1, V2: TFixedVector): TFixedVector; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    85 
    86 function Dot(const V1, V2: TFixedVector): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    87 function Distance(const V1, V2: TFixedVector): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    88 function SqrDistance(const V1, V2: TFixedVector): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     43  TLinePos = (lpStart, lpEnd, lpBoth, lpNeither);
     44
     45// TFloat Overloads
     46function Average(const V1, V2: TFloatPoint): TFloatPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     47function CrossProduct(V1, V2: TFloatPoint): TFloat; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
     48function Dot(const V1, V2: TFloatPoint): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     49function Distance(const V1, V2: TFloatPoint): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     50function SqrDistance(const V1, V2: TFloatPoint): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     51function GetPointAtAngleFromPoint(const Pt: TFloatPoint; const Dist, Radians: Single): TFloatPoint; overload;
     52function GetAngleOfPt2FromPt1(const Pt1, Pt2: TFloatPoint): Single; overload;
     53function GetUnitNormal(const Pt1, Pt2: TFloatPoint): TFloatPoint; overload;
     54function GetUnitVector(const Pt1, Pt2: TFloatPoint): TFloatPoint; overload;
     55function OffsetPoint(const Pt: TFloatPoint; DeltaX, DeltaY: TFloat): TFloatPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     56function OffsetPoint(const Pt, Delta: TFloatPoint): TFloatPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     57function OffsetRect(const Rct: TFloatRect; const DeltaX, DeltaY: TFloat): TFloatRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     58function OffsetRect(const Rct: TFloatRect; const Delta: TFloatPoint): TFloatRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     59function Shorten(const Pts: TArrayOfFloatPoint;
     60  Delta: TFloat; LinePos: TLinePos): TArrayOfFloatPoint; overload;
     61function PointInPolygon(const Pt: TFloatPoint; const Pts: TArrayOfFloatPoint): Boolean; overload;
     62function SegmentIntersect(const P1, P2, P3, P4: TFloatPoint;
     63  out IntersectPoint: TFloatPoint): Boolean; overload;
     64function PerpendicularDistance(const P, P1, P2: TFloatPoint): TFloat; overload;
     65
     66
     67// TFixed Overloads
     68function Average(const V1, V2: TFixedPoint): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     69function CrossProduct(V1, V2: TFixedPoint): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     70function Dot(const V1, V2: TFixedPoint): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     71function Distance(const V1, V2: TFixedPoint): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     72function SqrDistance(const V1, V2: TFixedPoint): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     73function GetPointAtAngleFromPoint(const Pt: TFixedPoint; const Dist, Radians: Single): TFixedPoint; overload;
     74function GetAngleOfPt2FromPt1(Pt1, Pt2: TFixedPoint): Single; overload;
     75function GetUnitVector(const Pt1, Pt2: TFixedPoint): TFloatPoint; overload;
     76function GetUnitNormal(const Pt1, Pt2: TFixedPoint): TFloatPoint; overload;
     77function OffsetPoint(const Pt: TFixedPoint; DeltaX, DeltaY: TFixed): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     78function OffsetPoint(const Pt: TFixedPoint; DeltaX, DeltaY: TFloat): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     79function OffsetPoint(const Pt: TFixedPoint; const Delta: TFixedPoint): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     80function OffsetPoint(const Pt: TFixedPoint; const Delta: TFloatPoint): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     81function OffsetRect(const Rct: TFixedRect; const DeltaX, DeltaY: TFixed): TFixedRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     82function OffsetRect(const Rct: TFixedRect; const DeltaX, DeltaY: TFloat): TFixedRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     83function OffsetRect(const Rct: TFixedRect; const Delta: TFixedPoint): TFixedRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     84function OffsetRect(const Rct: TFixedRect; const Delta: TFloatPoint): TFixedRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     85function Shorten(const Pts: TArrayOfFixedPoint;
     86  Delta: TFloat; LinePos: TLinePos): TArrayOfFixedPoint; overload;
     87function PointInPolygon(const Pt: TFixedPoint; const Pts: array of TFixedPoint): Boolean; overload;
     88function SegmentIntersect(const P1, P2, P3, P4: TFixedPoint;
     89  out IntersectPoint: TFixedPoint): Boolean; overload;
     90function PerpendicularDistance(const P, P1, P2: TFixedPoint): TFixed; overload;
     91
     92// Integer Overloads
     93function Average(const V1, V2: TPoint): TPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     94function CrossProduct(V1, V2: TPoint): Integer; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     95function Dot(const V1, V2: TPoint): Integer; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     96function Distance(const V1, V2: TPoint): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     97function SqrDistance(const V1, V2: TPoint): Integer; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     98function OffsetPoint(const Pt: TPoint; DeltaX, DeltaY: Integer): TPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     99function OffsetPoint(const Pt, Delta: TPoint): TPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     100function PerpendicularDistance(const P, P1, P2: TPoint): TFloat; overload;
     101
     102const
     103  CRad01 = Pi / 180;
     104  CRad30 = Pi / 6;
     105  CRad45 = Pi / 4;
     106  CRad60 = Pi / 3;
     107  CRad90 = Pi / 2;
     108  CRad180 = Pi;
     109  CRad270 = CRad90 * 3;
     110  CRad360 = CRad180 * 2;
     111  CDegToRad = Pi / 180;
     112  CRadToDeg = 180 / Pi;
    89113
    90114implementation
    91115
    92 function Add(const V1, V2: TFloatVector): TFloatVector;
    93 begin
    94   Result.X := V1.X + V2.X;
    95   Result.Y := V1.Y + V2.Y;
    96 end;
    97 
    98 function Add(const V: TFloatVector; Value: TFloat): TFloatVector;
    99 begin
    100   Result.X := V.X + Value;
    101   Result.Y := V.Y + Value;
    102 end;
    103 
    104 function Sub(const V1, V2: TFloatVector): TFloatVector;
    105 begin
    106   Result.X := V1.X - V2.X;
    107   Result.Y := V1.Y - V2.Y;
    108 end;
    109 
    110 function Sub(const V: TFloatVector; Value: TFloat): TFloatVector;
    111 begin
    112   Result.X := V.X - Value;
    113   Result.Y := V.Y - Value;
    114 end;
    115 
    116 function Mul(const V1, V2: TFloatVector): TFloatVector;
    117 begin
    118   Result.X := V1.X * V2.X;
    119   Result.Y := V1.Y * V2.Y;
    120 end;
    121 
    122 function Mul(const V: TFloatVector; Multiplier: TFloat): TFloatVector;
    123 begin
    124   Result.X := V.X * Multiplier;
    125   Result.Y := V.Y * Multiplier;
    126 end;
    127 
    128 function Divide(const V: TFloatVector; Divisor: TFloat): TFloatVector;
    129 begin
    130   Divisor := 1 / Divisor;
    131   Result.X := V.X * Divisor;
    132   Result.Y := V.Y * Divisor;
    133 end;
    134 
    135 function Divide(const V1, V2: TFloatVector): TFloatVector;
    136 begin
    137   Result.X := V1.X / V2.X;
    138   Result.Y := V1.Y / V2.Y;
    139 end;
    140 
    141 function Combine(const V1, V2: TFloatVector; W: TFloat): TFloatVector;
    142 begin
    143   Result.X := V2.X + (V1.X - V2.X) * W;
    144   Result.Y := V2.Y + (V1.Y - V2.Y) * W;
    145 end;
    146 
    147 function AbsV(const V: TFloatVector): TFloatVector;
    148 begin
    149   Result.X := System.Abs(V.X);
    150   Result.Y := System.Abs(V.Y);
    151 end;
    152 
    153 function Neg(const V: TFloatVector): TFloatVector;
    154 begin
    155   Result.X := - V.X;
    156   Result.Y := - V.Y;
    157 end;
    158 
    159 function Average(const V1, V2: TFloatVector): TFloatVector;
     116uses
     117  GR32_Math;
     118
     119function Average(const V1, V2: TFloatPoint): TFloatPoint;
    160120begin
    161121  Result.X := (V1.X + V2.X) * 0.5;
     
    163123end;
    164124
    165 function Max(const V1, V2: TFloatVector): TFloatVector;
    166 begin
    167   Result := V1;
    168   if V2.X > V1.X then Result.X := V2.X;
    169   if V2.Y > V1.Y then Result.Y := V2.Y;
    170 end;
    171 
    172 function Min(const V1, V2: TFloatVector): TFloatVector;
    173 begin
    174   Result := V1;
    175   if V2.X < V1.X then Result.X := V2.X;
    176   if V2.Y < V1.Y then Result.Y := V2.Y;
    177 end;
    178 
    179 function Dot(const V1, V2: TFloatVector): TFloat;
     125function CrossProduct(V1, V2: TFloatPoint): TFloat;
     126begin
     127  Result := V1.X * V2.Y - V1.Y * V2.X;
     128end;
     129
     130function Dot(const V1, V2: TFloatPoint): TFloat;
    180131begin
    181132  Result := V1.X * V2.X + V1.Y * V2.Y;
    182133end;
    183134
    184 function Distance(const V1, V2: TFloatVector): TFloat;
    185 begin
    186   Result := Hypot(V2.X - V1.X, V2.Y - V1.Y);
    187 end;
    188 
    189 function SqrDistance(const V1, V2: TFloatVector): TFloat;
     135function Distance(const V1, V2: TFloatPoint): TFloat;
     136begin
     137  Result := GR32_Math.Hypot(V2.X - V1.X, V2.Y - V1.Y);
     138end;
     139
     140function SqrDistance(const V1, V2: TFloatPoint): TFloat;
    190141begin
    191142  Result := Sqr(V2.X - V1.X) + Sqr(V2.Y - V1.Y);
    192143end;
    193144
     145function GetPointAtAngleFromPoint(const Pt: TFloatPoint;
     146  const Dist, Radians: TFloat): TFloatPoint; overload;
     147var
     148  SinAng, CosAng: TFloat;
     149begin
     150  GR32_Math.SinCos(Radians, SinAng, CosAng);
     151  Result.X :=  Dist * CosAng + Pt.X;
     152  Result.Y := -Dist * SinAng + Pt.Y; // Y axis is positive down
     153end;
     154
     155function GetAngleOfPt2FromPt1(const Pt1, Pt2: TFloatPoint): Single;
     156var
     157  X, Y: TFloat;
     158begin
     159  X := Pt2.X - Pt1.X;
     160  Y := Pt2.Y - Pt1.Y;
     161  if X = 0 then
     162  begin
     163    if Y > 0 then Result := CRad270 else Result := CRad90;
     164  end else
     165  begin
     166    Result := ArcTan2(-Y, X);
     167    if Result < 0 then Result := Result + CRad360;
     168  end;
     169end;
     170
     171function GetUnitVector(const Pt1, Pt2: TFloatPoint): TFloatPoint;
     172var
     173  Delta: TFloatPoint;
     174  Temp: TFloat;
     175begin
     176  Delta.X := (Pt2.X - Pt1.X);
     177  Delta.Y := (Pt2.Y - Pt1.Y);
     178  if (Delta.X = 0) and (Delta.Y = 0) then
     179    Result := FloatPoint(0, 0)
     180  else
     181  begin
     182    Temp := 1 / GR32_Math.Hypot(Delta.X, Delta.Y);
     183    Result.X := Delta.X * Temp;
     184    Result.Y := Delta.Y * Temp;
     185  end;
     186end;
     187
     188function GetUnitNormal(const Pt1, Pt2: TFloatPoint): TFloatPoint;
     189var
     190  Delta: TFloatPoint;
     191  Temp: TFloat;
     192begin
     193  Delta.X := (Pt2.X - Pt1.X);
     194  Delta.Y := (Pt2.Y - Pt1.Y);
     195
     196  if (Delta.X = 0) and (Delta.Y = 0) then
     197    Result := FloatPoint(0, 0)
     198  else
     199  begin
     200    Temp := 1 / GR32_Math.Hypot(Delta.X, Delta.Y);
     201    Delta.X := Delta.X * Temp;
     202    Delta.Y := Delta.Y * Temp;
     203  end;
     204  Result.X :=  Delta.Y; // ie perpendicular to
     205  Result.Y := -Delta.X; // the unit vector
     206end;
     207
     208function OffsetPoint(const Pt: TFloatPoint; DeltaX, DeltaY: TFloat): TFloatPoint;
     209begin
     210  Result.X := Pt.X + DeltaX;
     211  Result.Y := Pt.Y + DeltaY;
     212end;
     213
     214function OffsetPoint(const Pt, Delta: TFloatPoint): TFloatPoint;
     215begin
     216  Result.X := Pt.X + Delta.X;
     217  Result.Y := Pt.Y + Delta.Y;
     218end;
     219
     220function OffsetRect(const Rct: TFloatRect; const DeltaX, DeltaY: TFloat): TFloatRect;
     221begin
     222  Result.TopLeft := OffsetPoint(Rct.TopLeft, DeltaX, DeltaY);
     223  Result.BottomRight := OffsetPoint(Rct.BottomRight, DeltaX, DeltaY);
     224end;
     225
     226function OffsetRect(const Rct: TFloatRect; const Delta: TFloatPoint): TFloatRect;
     227begin
     228  Result.TopLeft := OffsetPoint(Rct.TopLeft, Delta);
     229  Result.BottomRight := OffsetPoint(Rct.BottomRight, Delta);
     230end;
     231
     232
     233function Shorten(const Pts: TArrayOfFloatPoint;
     234  Delta: TFloat; LinePos: TLinePos): TArrayOfFloatPoint;
     235var
     236  Index, HighI: integer;
     237  Dist, DeltaSqr: TFloat;
     238  UnitVec: TFloatPoint;
     239
     240  procedure FixStart;
     241  begin
     242    Index := 1;
     243    while (Index < HighI) and (SqrDistance(Pts[Index], Pts[0]) < DeltaSqr) do
     244      Inc(Index);
     245    UnitVec := GetUnitVector(Pts[Index], Pts[0]);
     246    Dist := Distance(Pts[Index], Pts[0]) - Delta;
     247    if Index > 1 then
     248    begin
     249      HighI := HighI - Index + 1;
     250      Move(Result[Index], Result[1], SizeOf(TFloatPoint) * HighI);
     251      SetLength(Result, HighI + 1);
     252    end;
     253    Result[0] := OffsetPoint(Result[1], UnitVec.X * Dist, UnitVec.Y * Dist);
     254  end;
     255
     256  procedure FixEnd;
     257  begin
     258    Index := HighI - 1;
     259    while (Index > 0) and (SqrDistance(Pts[Index],Pts[HighI]) < DeltaSqr) do
     260      Dec(Index);
     261    UnitVec := GetUnitVector(Pts[Index],Pts[HighI]);
     262    Dist := Distance(Pts[Index], Pts[HighI]) - Delta;
     263    if Index + 1 < HighI then SetLength(Result, Index + 2);
     264    Result[Index + 1] := OffsetPoint(Result[Index], UnitVec.X * Dist, UnitVec.Y * Dist);
     265  end;
     266
     267begin
     268  Result := Pts;
     269  HighI := High(Pts);
     270  DeltaSqr := Delta * Delta;
     271  if HighI < 1 then Exit;
     272
     273  case LinePos of
     274    lpStart: FixStart;
     275    lpEnd  : FixEnd;
     276    lpBoth : begin FixStart; FixEnd; end;
     277  end;
     278end;
     279
     280function PointInPolygon(const Pt: TFloatPoint; const Pts: TArrayOfFloatPoint): Boolean;
     281var
     282  Index: Integer;
     283  iPt, jPt: PFloatPoint;
     284begin
     285  Result := False;
     286  iPt := @Pts[0];
     287  jPt := @Pts[High(Pts)];
     288  for Index := 0 to High(Pts) do
     289  begin
     290    Result := Result xor (((Pt.Y >= iPt.Y) xor (Pt.Y >= jPt.Y)) and
     291      ((Pt.X - iPt.X) < ((jPt.X - iPt.X) * (Pt.Y -iPt.Y) / (jPt.Y - iPt.Y))));
     292    jPt := iPt;
     293    Inc(iPt);
     294  end;
     295end;
     296
     297function SegmentIntersect(const P1, P2, P3, P4: TFloatPoint;
     298  out IntersectPoint: TFloatPoint): Boolean;
     299var
     300  m1, b1, m2, b2: TFloat;
     301begin
     302  // see http://astronomy.swin.edu.au/~pbourke/geometry/lineline2d/
     303  Result := False;
     304  if (P2.X = P1.X) then
     305  begin
     306    if (P4.X = P3.X) then Exit; // parallel lines
     307    m2 := (P4.Y - P3.Y) / (P4.X - P3.X);
     308    b2 := P3.Y - m2 * P3.X;
     309    IntersectPoint.X := P1.X;
     310    IntersectPoint.Y := m2 * P1.X + b2;
     311    Result := (((IntersectPoint.Y < P2.Y) = (IntersectPoint.Y > P1.Y)) or
     312      (IntersectPoint.Y = P2.Y) or (IntersectPoint.Y = P1.Y)) and
     313      (((IntersectPoint.Y < P3.Y) = (IntersectPoint.Y > P4.Y)) or
     314      (IntersectPoint.Y = P3.Y) or (IntersectPoint.Y = P4.Y));
     315  end
     316  else if (P4.X = P3.X) then
     317  begin
     318    m1 := (P2.Y - P1.Y) / (P2.X - P1.X);
     319    b1 := P1.Y - m1 * P1.X;
     320    IntersectPoint.X := P3.X;
     321    IntersectPoint.Y := m1 * P3.X + b1;
     322    Result := (((IntersectPoint.Y < P2.Y) = (IntersectPoint.Y > P1.Y)) or
     323      (IntersectPoint.Y = P2.Y) or (IntersectPoint.Y = P1.Y)) and
     324      (((IntersectPoint.Y < P3.Y) = (IntersectPoint.Y > P4.Y)) or
     325      (IntersectPoint.Y = P3.Y) or (IntersectPoint.Y = P4.Y));
     326  end else
     327  begin
     328    m1 := (P2.Y - P1.Y) / (P2.X - P1.X);
     329    b1 := P1.Y - m1 * P1.X;
     330    m2 := (P4.Y - P3.Y) / (P4.X - P3.X);
     331    b2 := P3.Y - m2 * P3.X;
     332    if m1 = m2 then Exit; // parallel lines
     333    IntersectPoint.X := (b2 - b1) / (m1 - m2);
     334    IntersectPoint.Y := m1 * IntersectPoint.X + b1;
     335    Result := (((IntersectPoint.X < P2.X) = (IntersectPoint.X > P1.X)) or
     336      (IntersectPoint.X = P2.X) or (IntersectPoint.X = P1.X)) and
     337      (((IntersectPoint.X < P3.X) = (IntersectPoint.X > P4.X)) or
     338      (IntersectPoint.X = P3.X) or (IntersectPoint.X = P4.X));
     339  end;
     340end;
     341
     342function PerpendicularDistance(const P, P1, P2: TFloatPoint): TFloat;
     343begin
     344  Result := Abs((P.x - P2.x) * (P1.y - P2.y) - (P.y - P2.y) * (P1.x - P2.x)) /
     345    GR32_Math.Hypot(P1.x - P2.x, P1.y - P2.y);
     346end;
     347
     348
    194349// Fixed overloads
    195350
    196 function Add(const V1, V2: TFixedVector): TFixedVector;
    197 begin
    198   Result.X := V1.X + V2.X;
    199   Result.Y := V1.Y + V2.Y;
    200 end;
    201 
    202 function Add(const V: TFixedVector; Value: TFixed): TFixedVector;
    203 begin
    204   Result.X := V.X + Value;
    205   Result.Y := V.Y + Value;
    206 end;
    207 
    208 function Sub(const V1, V2: TFixedVector): TFixedVector;
    209 begin
    210   Result.X := V1.X - V2.X;
    211   Result.Y := V1.Y - V2.Y;
    212 end;
    213 
    214 function Sub(const V: TFixedVector; Value: TFixed): TFixedVector;
    215 begin
    216   Result.X := V.X - Value;
    217   Result.Y := V.Y - Value;
    218 end;
    219 
    220 function Mul(const V1, V2: TFixedVector): TFixedVector;
    221 begin
    222   Result.X := FixedMul(V1.X, V2.X);
    223   Result.Y := FixedMul(V1.Y, V2.Y);
    224 end;
    225 
    226 function Mul(const V: TFixedVector; Multiplier: TFixed): TFixedVector;
    227 begin
    228   Result.X := FixedMul(V.X, Multiplier);
    229   Result.Y := FixedMul(V.Y, Multiplier);
    230 end;
    231 
    232 function Divide(const V: TFixedVector; Divisor: TFixed): TFixedVector;
    233 var
    234   D: TFloat;
    235 begin
    236   D := FIXEDONE / Divisor;
    237   Result.X := Round(V.X * D);
    238   Result.Y := Round(V.Y * D);
    239 end;
    240 
    241 function Divide(const V1, V2: TFixedVector): TFixedVector;
    242 begin
    243   Result.X := FixedDiv(V1.X, V2.X);
    244   Result.Y := FixedDiv(V1.Y, V2.Y);
    245 end;
    246 
    247 function Combine(const V1, V2: TFixedVector; W: TFixed): TFixedVector;
    248 begin
    249   Result.X := V2.X + FixedMul(V1.X - V2.X, W);
    250   Result.Y := V2.Y + FixedMul(V1.Y - V2.Y, W);
    251 end;
    252 
    253 function AbsV(const V: TFixedVector): TFixedVector;
    254 begin
    255   Result.X := System.Abs(V.X);
    256   Result.Y := System.Abs(V.Y);
    257 end;
    258 
    259 function Neg(const V: TFixedVector): TFixedVector;
    260 begin
    261   Result.X := - V.X;
    262   Result.Y := - V.Y;
    263 end;
    264 
    265 function Average(const V1, V2: TFixedVector): TFixedVector;
     351function Average(const V1, V2: TFixedPoint): TFixedPoint;
    266352begin
    267353  Result.X := (V1.X + V2.X) div 2;
     
    269355end;
    270356
    271 function Max(const V1, V2: TFixedVector): TFixedVector;
    272 begin
    273   Result := V1;
    274   if V2.X > V1.X then Result.X := V2.X;
    275   if V2.Y > V1.Y then Result.Y := V2.Y;
    276 end;
    277 
    278 function Min(const V1, V2: TFixedVector): TFixedVector;
    279 begin
    280   Result := V1;
    281   if V2.X < V1.X then Result.X := V2.X;
    282   if V2.Y < V1.Y then Result.Y := V2.Y;
    283 end;
    284 
    285 function Dot(const V1, V2: TFixedVector): TFixed;
     357function CrossProduct(V1, V2: TFixedPoint): TFixed;
     358begin
     359  Result := FixedMul(V1.X, V2.Y) - FixedMul(V1.Y, V2.X);
     360end;
     361
     362function Dot(const V1, V2: TFixedPoint): TFixed;
    286363begin
    287364  Result := FixedMul(V1.X, V2.X) + FixedMul(V1.Y, V2.Y);
    288365end;
    289366
    290 function Distance(const V1, V2: TFixedVector): TFixed;
    291 begin
    292   Result := Fixed(Hypot((V2.X - V1.X) * FixedToFloat, (V2.Y - V1.Y) * FixedToFloat));
    293 end;
    294 
    295 function SqrDistance(const V1, V2: TFixedVector): TFixed;
     367function Distance(const V1, V2: TFixedPoint): TFixed;
     368begin
     369  Result :=
     370    Fixed(Hypot((V2.X - V1.X) * FixedToFloat, (V2.Y - V1.Y) * FixedToFloat));
     371end;
     372
     373function SqrDistance(const V1, V2: TFixedPoint): TFixed;
    296374begin
    297375  Result := FixedSqr(V2.X - V1.X) + FixedSqr(V2.Y - V1.Y);
    298376end;
    299377
     378function GetPointAtAngleFromPoint(const Pt: TFixedPoint;
     379  const Dist, Radians: TFloat): TFixedPoint;
     380var
     381  SinAng, CosAng: TFloat;
     382begin
     383  GR32_Math.SinCos(Radians, SinAng, CosAng);
     384  Result.X := Round(Dist * CosAng * FixedOne) + Pt.X;
     385  Result.Y := -Round(Dist * SinAng * FixedOne) + Pt.Y; // Y axis is positive down
     386end;
     387
     388function GetAngleOfPt2FromPt1(Pt1, Pt2: TFixedPoint): Single;
     389begin
     390  with Pt2 do
     391  begin
     392    X := X - Pt1.X;
     393    Y := Y - Pt1.Y;
     394    if X = 0 then
     395    begin
     396     if Y > 0 then Result := CRad270 else Result := CRad90;
     397    end else
     398    begin
     399      Result := ArcTan2(-Y,X);
     400      if Result < 0 then Result := Result + CRad360;
     401    end;
     402  end;
     403end;
     404
     405function GetUnitVector(const Pt1, Pt2: TFixedPoint): TFloatPoint;
     406var
     407  Delta: TFloatPoint;
     408  Temp: Single;
     409begin
     410  Delta.X := (Pt2.X - Pt1.X) * FixedToFloat;
     411  Delta.Y := (Pt2.Y - Pt1.Y) * FixedToFloat;
     412  if (Delta.X = 0) and (Delta.Y = 0) then
     413  begin
     414    Result := FloatPoint(0,0);
     415  end else
     416  begin
     417    Temp := 1 / GR32_Math.Hypot(Delta.X, Delta.Y);
     418    Result.X := Delta.X * Temp;
     419    Result.Y := Delta.Y * Temp;
     420  end;
     421end;
     422
     423function GetUnitNormal(const Pt1, Pt2: TFixedPoint): TFloatPoint;
     424var
     425  Delta: TFloatPoint;
     426  Temp: Single;
     427begin
     428  Delta.X := (Pt2.X - Pt1.X) * FixedToFloat;
     429  Delta.Y := (Pt2.Y - Pt1.Y) * FixedToFloat;
     430
     431  if (Delta.X = 0) and (Delta.Y = 0) then
     432  begin
     433    Result := FloatPoint(0,0);
     434  end else
     435  begin
     436    Temp := 1 / GR32_Math.Hypot(Delta.X, Delta.Y);
     437    Delta.X := Delta.X * Temp;
     438    Delta.Y := Delta.Y * Temp;
     439  end;
     440  Result.X :=  Delta.Y; // ie perpendicular to
     441  Result.Y := -Delta.X; // the unit vector
     442end;
     443
     444function OffsetPoint(const Pt: TFixedPoint; DeltaX, DeltaY: TFixed): TFixedPoint;
     445begin
     446  Result.X := Pt.X + DeltaX;
     447  Result.Y := Pt.Y + DeltaY;
     448end;
     449
     450function OffsetPoint(const Pt: TFixedPoint; DeltaX, DeltaY: TFloat): TFixedPoint;
     451begin
     452  Result.X := Pt.X + Fixed(DeltaX);
     453  Result.Y := Pt.Y + Fixed(DeltaY);
     454end;
     455
     456function OffsetPoint(const Pt: TFixedPoint; const Delta: TFixedPoint): TFixedPoint;
     457begin
     458  Result.X := Pt.X + Delta.X;
     459  Result.Y := Pt.Y + Delta.Y;
     460end;
     461
     462function OffsetPoint(const Pt: TFixedPoint; const Delta: TFloatPoint): TFixedPoint;
     463begin
     464  Result.X := Pt.X + Fixed(Delta.X);
     465  Result.Y := Pt.Y + Fixed(Delta.Y);
     466end;
     467
     468function OffsetRect(const Rct: TFixedRect; const DeltaX, DeltaY: TFixed): TFixedRect;
     469begin
     470  Result.TopLeft := OffsetPoint(Rct.TopLeft, DeltaX, DeltaY);
     471  Result.BottomRight := OffsetPoint(Rct.BottomRight, DeltaX, DeltaY);
     472end;
     473
     474function OffsetRect(const Rct: TFixedRect; const Delta: TFixedPoint): TFixedRect;
     475begin
     476  Result.TopLeft := OffsetPoint(Rct.TopLeft, Delta);
     477  Result.BottomRight := OffsetPoint(Rct.BottomRight, Delta);
     478end;
     479
     480function OffsetRect(const Rct: TFixedRect; const DeltaX, DeltaY: TFloat): TFixedRect;
     481var
     482  DX, DY: TFixed;
     483begin
     484  DX := Fixed(DeltaX);
     485  DY := Fixed(DeltaY);
     486  Result.TopLeft := OffsetPoint(Rct.TopLeft, DX, DY);
     487  Result.BottomRight := OffsetPoint(Rct.BottomRight, DX, DY);
     488end;
     489
     490function OffsetRect(const Rct: TFixedRect; const Delta: TFloatPoint): TFixedRect;
     491var
     492  DX, DY: TFixed;
     493begin
     494  DX := Fixed(Delta.X);
     495  DY := Fixed(Delta.Y);
     496  Result.TopLeft := OffsetPoint(Rct.TopLeft, DX, DY);
     497  Result.BottomRight := OffsetPoint(Rct.BottomRight, DX, DY);
     498end;
     499
     500function Shorten(const Pts: TArrayOfFixedPoint;
     501  Delta: TFloat; LinePos: TLinePos): TArrayOfFixedPoint;
     502var
     503  Index, HighI: integer;
     504  Dist, DeltaSqr: TFloat;
     505  UnitVec: TFloatPoint;
     506
     507  procedure FixStart;
     508  begin
     509    Index := 1;
     510    while (Index < HighI) and (SqrDistance(Pts[Index],Pts[0]) < DeltaSqr) do Inc(Index);
     511    UnitVec := GetUnitVector(Pts[Index], Pts[0]);
     512    Dist := Distance(Pts[Index],Pts[0]) - Delta;
     513    if Index > 1 then
     514    begin
     515      Move(Result[Index], Result[1], SizeOf(TFloatPoint) * (HighI - Index + 1));
     516      SetLength(Result, HighI - Index + 2);
     517      HighI := HighI - Index + 1;
     518    end;
     519    Result[0] := OffsetPoint(Result[1], UnitVec.X * Dist, UnitVec.Y * Dist);
     520  end;
     521
     522  procedure FixEnd;
     523  begin
     524    Index := HighI -1;
     525    while (Index > 0) and (SqrDistance(Pts[Index],Pts[HighI]) < DeltaSqr) do Dec(Index);
     526    UnitVec := GetUnitVector(Pts[Index],Pts[HighI]);
     527    Dist := Distance(Pts[Index],Pts[HighI]) - Delta;
     528    if Index + 1 < HighI then SetLength(Result, Index + 2);
     529    Result[Index + 1] := OffsetPoint(Result[Index], UnitVec.X * Dist, UnitVec.Y * Dist);
     530  end;
     531
     532begin
     533  Result := Pts;
     534  HighI := High(Pts);
     535  DeltaSqr := Delta * Delta;
     536  if HighI < 1 then Exit;
     537
     538  case LinePos of
     539    lpStart: FixStart;
     540    lpEnd  : FixEnd;
     541    lpBoth : begin FixStart; FixEnd; end;
     542  end;
     543end;
     544
     545function PointInPolygon(const Pt: TFixedPoint; const Pts: array of TFixedPoint): Boolean;
     546var
     547  I: Integer;
     548  iPt, jPt: PFixedPoint;
     549begin
     550  Result := False;
     551  iPt := @Pts[0];
     552  jPt := @Pts[High(Pts)];
     553  for I := 0 to High(Pts) do
     554  begin
     555    Result := Result xor (((Pt.Y >= iPt.Y) xor (Pt.Y >= jPt.Y)) and
     556      (Pt.X - iPt.X < MulDiv(jPt.X - iPt.X, Pt.Y - iPt.Y, jPt.Y - iPt.Y)));
     557    jPt := iPt;
     558    Inc(iPt);
     559  end;
     560end;
     561
     562function SegmentIntersect(const P1, P2, P3, P4: TFixedPoint;
     563  out IntersectPoint: TFixedPoint): Boolean;
     564var
     565  m1,b1,m2,b2: TFloat;
     566begin
     567  Result := False;
     568  if (P2.X = P1.X) then
     569  begin
     570    if (P4.X = P3.X) then Exit; // parallel lines
     571    m2 := (P4.Y - P3.Y) / (P4.X - P3.X);
     572    b2 := P3.Y - m2 * P3.X;
     573    IntersectPoint.X := P1.X;
     574    IntersectPoint.Y := Round(m2 * P1.X + b2);
     575    Result := (IntersectPoint.Y < P2.Y) = (IntersectPoint.Y > P1.Y);
     576  end
     577  else if (P4.X = P3.X) then
     578  begin
     579    m1 := (P2.Y - P1.Y) / (P2.X - P1.X);
     580    b1 := P1.Y - m1 * P1.X;
     581    IntersectPoint.X := P3.X;
     582    IntersectPoint.Y := Round(m1 * P3.X + b1);
     583    Result := (IntersectPoint.Y < P3.Y) = (IntersectPoint.Y > P4.Y);
     584  end else
     585  begin
     586    m1 := (P2.Y - P1.Y) / (P2.X - P1.X);
     587    b1 := P1.Y - m1 * P1.X;
     588    m2 := (P4.Y - P3.Y) / (P4.X - P3.X);
     589    b2 := P3.Y - m2 * P3.X;
     590    if m1 = m2 then Exit; // parallel lines
     591    IntersectPoint.X := Round((b2 - b1) / (m1 - m2));
     592    IntersectPoint.Y := Round(m1 * IntersectPoint.X + b1);
     593    Result := ((IntersectPoint.X < P2.X) = (IntersectPoint.X > P1.X));
     594  end;
     595end;
     596
     597function PerpendicularDistance(const P, P1, P2: TFixedPoint): TFixed;
     598begin
     599  Result := Fixed(Abs((P.x - P2.x) * (P1.y - P2.y) - (P.y - P2.y) *
     600    (P1.x - P2.x)) * FixedToFloat / Hypot((P1.x - P2.x) * FixedToFloat,
     601    (P1.y - P2.y) * FixedToFloat));
     602end;
     603
     604
     605// Integer overloads
     606
     607function Average(const V1, V2: TPoint): TPoint;
     608begin
     609  Result.X := (V1.X + V2.X) div 2;
     610  Result.Y := (V1.Y + V2.Y) div 2;
     611end;
     612
     613function CrossProduct(V1, V2: TPoint): Integer;
     614begin
     615  Result := V1.X * V2.Y - V1.Y * V2.X;
     616end;
     617
     618function Dot(const V1, V2: TPoint): Integer;
     619begin
     620  Result := V1.X * V2.X + V1.Y * V2.Y;
     621end;
     622
     623function Distance(const V1, V2: TPoint): TFloat;
     624begin
     625  Result := Hypot(Integer(V2.X - V1.X), Integer(V2.Y - V1.Y));
     626end;
     627
     628function SqrDistance(const V1, V2: TPoint): Integer;
     629begin
     630  Result := Sqr(V2.X - V1.X) + Sqr(V2.Y - V1.Y);
     631end;
     632
     633function OffsetPoint(const Pt: TPoint; DeltaX, DeltaY: Integer): TPoint;
     634begin
     635  Result.X := Pt.X + DeltaX;
     636  Result.Y := Pt.Y + DeltaY;
     637end;
     638
     639function OffsetPoint(const Pt, Delta: TPoint): TPoint;
     640begin
     641  Result.X := Pt.X + Delta.X;
     642  Result.Y := Pt.Y + Delta.Y;
     643end;
     644
     645function PerpendicularDistance(const P, P1, P2: TPoint): TFloat;
     646begin
     647  Result := Abs((P.x - P2.x) * (P1.y - P2.y) - (P.y - P2.y) * (P1.x - P2.x)) /
     648    Math.Hypot(P1.x - P2.x, P1.y - P2.y);
     649end;
     650
    300651end.
  • GraphicTest/Packages/Graphics32/GR32_Image.pas

    r450 r522  
    4949{$ENDIF}
    5050  Graphics, Controls, Forms,
    51   Classes, SysUtils, GR32, GR32_Layers, GR32_RangeBars, GR32_LowLevel,
    52   GR32_System, GR32_Containers, GR32_RepaintOpt;
     51  Classes, SysUtils, GR32, GR32_Layers, GR32_RangeBars, GR32_Containers,
     52  GR32_RepaintOpt;
    5353
    5454const
     
    118118    procedure CMMouseEnter(var Message: TLMessage); message LM_MOUSEENTER;
    119119    procedure CMMouseLeave(var Message: TLMessage); message LM_MOUSELEAVE;
    120     procedure CMInvalidate(var Message: TLMessage); message CM_INVALIDATE;
    121120{$ELSE}
    122121    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
     
    278277    procedure InvalidateCache;
    279278    function  InvalidRectsAvailable: Boolean; override;
    280     procedure DblClick; override;
    281279    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); overload; override;
    282280    procedure MouseMove(Shift: TShiftState; X, Y: Integer); overload; override;
     
    366364    property OnClick;
    367365    property OnChange;
     366    property OnContextPopup;
    368367    property OnDblClick;
    369368    property OnGDIOverlay;
     
    653652{ TCustomPaintBox32 }
    654653
    655 {$IFDEF FPC}
    656 procedure TCustomPaintBox32.CMInvalidate(var Message: TLMessage);
    657 begin
    658   if CustomRepaint and HandleAllocated then
    659     PostMessage(Handle, LM_PAINT, 0, 0)
    660   else
    661     inherited;
    662 end;
    663 {$ELSE}
    664 
     654{$IFNDEF FPC}
    665655procedure TCustomPaintBox32.CMInvalidate(var Message: TMessage);
    666656begin
     
    848838end;
    849839
    850 procedure TCustomPaintBox32.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     840procedure TCustomPaintBox32.MouseDown(Button: TMouseButton; Shift: TShiftState;
     841  X, Y: Integer);
    851842begin
    852843  if (pboAutoFocus in Options) and CanFocus then SetFocus;
     
    874865
    875866  if FRepaintOptimizer.Enabled then
    876   begin
    877867    FRepaintOptimizer.BeginPaint;
    878   end;
    879868
    880869  if not FBufferValid then
     
    984973procedure TCustomPaintBox32.WMGetDlgCode(var Msg: {$IFDEF FPC}TLMessage{$ELSE}TWmGetDlgCode{$ENDIF});
    985974begin
    986   with Msg do if pboWantArrowKeys in Options then
    987     Result:= Result or DLGC_WANTARROWS
    988   else
    989     Result:= Result and not DLGC_WANTARROWS;
     975  with Msg do
     976    if pboWantArrowKeys in Options then
     977      Result:= Result or DLGC_WANTARROWS
     978    else
     979      Result:= Result and not DLGC_WANTARROWS;
    990980end;
    991981
     
    10501040{ TCustomImage32 }
    10511041
     1042constructor TCustomImage32.Create(AOwner: TComponent);
     1043begin
     1044  inherited;
     1045  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
     1046    csDoubleClicks, csReplicatable, csOpaque];
     1047  FBitmap := TBitmap32.Create;
     1048  FBitmap.OnResize := BitmapResizeHandler;
     1049
     1050  FLayers := TLayerCollection.Create(Self);
     1051  with TLayerCollectionAccess(FLayers) do
     1052  begin
     1053    OnChange := LayerCollectionChangeHandler;
     1054    OnGDIUpdate := LayerCollectionGDIUpdateHandler;
     1055    OnGetViewportScale := LayerCollectionGetViewportScaleHandler;
     1056    OnGetViewportShift := LayerCollectionGetViewportShiftHandler;
     1057  end;
     1058
     1059  FRepaintOptimizer.RegisterLayerCollection(FLayers);
     1060  RepaintMode := rmFull;
     1061
     1062  FPaintStages := TPaintStages.Create;
     1063  FScaleX := 1;
     1064  FScaleY := 1;
     1065  SetXForm(0, 0, 1, 1);
     1066
     1067  InitDefaultStages;
     1068end;
     1069
     1070destructor TCustomImage32.Destroy;
     1071begin
     1072  BeginUpdate;
     1073  FPaintStages.Free;
     1074  FRepaintOptimizer.UnregisterLayerCollection(FLayers);
     1075  FLayers.Free;
     1076  FBitmap.Free;
     1077  inherited;
     1078end;
     1079
    10521080procedure TCustomImage32.BeginUpdate;
    10531081begin
     
    11041132end;
    11051133
    1106 function TCustomImage32.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
    1107 var
    1108   W, H: Integer;
    1109 begin
    1110   InvalidateCache;
    1111   Result := True;
    1112   W := Bitmap.Width;
    1113   H := Bitmap.Height;
    1114   if ScaleMode = smScale then
    1115   begin
    1116     W := Round(W * Scale);
    1117     H := Round(H * Scale);
    1118   end;
    1119   if not (csDesigning in ComponentState) or (W > 0) and (H > 0) then
    1120   begin
    1121     if Align in [alNone, alLeft, alRight] then NewWidth := W;
    1122     if Align in [alNone, alTop, alBottom] then NewHeight := H;
    1123   end;
    1124 end;
    1125 
    1126 procedure TCustomImage32.Changed;
    1127 begin
    1128   if FUpdateCount = 0 then
    1129   begin
    1130     Invalidate;
    1131     if Assigned(FOnChange) then FOnChange(Self);
    1132   end;
    1133 end;
    1134 
    1135 procedure TCustomImage32.Update(const Rect: TRect);
    1136 begin
    1137   if FRepaintOptimizer.Enabled then
    1138     FRepaintOptimizer.AreaUpdateHandler(Self, Rect, AREAINFO_RECT);
    1139 end;
    1140 
    11411134procedure TCustomImage32.BitmapResizeHandler(Sender: TObject);
    11421135begin
     
    11501143end;
    11511144
    1152 procedure TCustomImage32.BitmapAreaChangeHandler(Sender: TObject; const Area: TRect; const Info: Cardinal);
     1145procedure TCustomImage32.BitmapAreaChangeHandler(Sender: TObject;
     1146  const Area: TRect; const Info: Cardinal);
    11531147var
    11541148  T, R: TRect;
     
    11851179end;
    11861180
    1187 procedure TCustomImage32.BitmapDirectAreaChangeHandler(Sender: TObject; const Area: TRect; const Info: Cardinal);
     1181procedure TCustomImage32.BitmapDirectAreaChangeHandler(Sender: TObject;
     1182  const Area: TRect; const Info: Cardinal);
    11881183var
    11891184  T, R: TRect;
     
    12241219end;
    12251220
    1226 procedure TCustomImage32.LayerCollectionChangeHandler(Sender: TObject);
    1227 begin
    1228   Changed;
    1229 end;
    1230 
    1231 procedure TCustomImage32.LayerCollectionGDIUpdateHandler(Sender: TObject);
    1232 begin
    1233   Paint;
    1234 end;
    1235 
    1236 procedure TCustomImage32.LayerCollectionGetViewportScaleHandler(Sender: TObject;
    1237   out ScaleX, ScaleY: TFloat);
    1238 begin
    1239   UpdateCache;
    1240   ScaleX := CachedScaleX;
    1241   ScaleY := CachedScaleY;
    1242 end;
    1243 
    1244 procedure TCustomImage32.LayerCollectionGetViewportShiftHandler(Sender: TObject;
    1245   out ShiftX, ShiftY: TFloat);
    1246 begin
    1247   UpdateCache;
    1248   ShiftX := CachedShiftX;
    1249   ShiftY := CachedShiftY;
     1221function TCustomImage32.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
     1222var
     1223  W, H: Integer;
     1224begin
     1225  InvalidateCache;
     1226  Result := True;
     1227  W := Bitmap.Width;
     1228  H := Bitmap.Height;
     1229  if ScaleMode = smScale then
     1230  begin
     1231    W := Round(W * Scale);
     1232    H := Round(H * Scale);
     1233  end;
     1234  if not (csDesigning in ComponentState) or (W > 0) and (H > 0) then
     1235  begin
     1236    if Align in [alNone, alLeft, alRight] then NewWidth := W;
     1237    if Align in [alNone, alTop, alBottom] then NewHeight := H;
     1238  end;
     1239end;
     1240
     1241procedure TCustomImage32.Changed;
     1242begin
     1243  if FUpdateCount = 0 then
     1244  begin
     1245    Invalidate;
     1246    if Assigned(FOnChange) then FOnChange(Self);
     1247  end;
    12501248end;
    12511249
     
    12851283      Result.Y := (Y - CachedShiftY) * CachedRecScaleY;
    12861284  end;
    1287 end;
    1288 
    1289 
    1290 constructor TCustomImage32.Create(AOwner: TComponent);
    1291 begin
    1292   inherited;
    1293   ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    1294     csDoubleClicks, csReplicatable, csOpaque];
    1295   FBitmap := TBitmap32.Create;
    1296   FBitmap.OnResize := BitmapResizeHandler;
    1297 
    1298   FLayers := TLayerCollection.Create(Self);
    1299   with TLayerCollectionAccess(FLayers) do
    1300   begin
    1301     OnChange := LayerCollectionChangeHandler;
    1302     OnGDIUpdate := LayerCollectionGDIUpdateHandler;
    1303     OnGetViewportScale := LayerCollectionGetViewportScaleHandler;
    1304     OnGetViewportShift := LayerCollectionGetViewportShiftHandler;
    1305   end;
    1306 
    1307   FRepaintOptimizer.RegisterLayerCollection(FLayers);
    1308   RepaintMode := rmFull;
    1309 
    1310   FPaintStages := TPaintStages.Create;
    1311   FScaleX := 1;
    1312   FScaleY := 1;
    1313   SetXForm(0, 0, 1, 1);
    1314 
    1315   InitDefaultStages;
    1316 end;
    1317 
    1318 procedure TCustomImage32.DblClick;
    1319 begin
    1320   Layers.MouseListener := nil;
    1321   MouseUp(mbLeft, [], 0, 0);
    1322   inherited;
    1323 end;
    1324 
    1325 destructor TCustomImage32.Destroy;
    1326 begin
    1327   BeginUpdate;
    1328   FPaintStages.Free;
    1329   FRepaintOptimizer.UnregisterLayerCollection(FLayers);
    1330   FLayers.Free;
    1331   FBitmap.Free;
    1332   inherited;
    13331285end;
    13341286
     
    16741626procedure TCustomImage32.InvalidateCache;
    16751627begin
    1676   if FRepaintOptimizer.Enabled then FRepaintOptimizer.Reset;
     1628  if FRepaintOptimizer.Enabled and CacheValid then
     1629    FRepaintOptimizer.Reset;
    16771630  CacheValid := False;
    16781631end;
    16791632
     1633function TCustomImage32.InvalidRectsAvailable: Boolean;
     1634begin
     1635  // avoid calling inherited, we have a totally different behaviour here...
     1636  DoPrepareInvalidRects;
     1637  Result := FInvalidRects.Count > 0;
     1638end;
     1639
     1640procedure TCustomImage32.LayerCollectionChangeHandler(Sender: TObject);
     1641begin
     1642  Changed;
     1643end;
     1644
     1645procedure TCustomImage32.LayerCollectionGDIUpdateHandler(Sender: TObject);
     1646begin
     1647  Paint;
     1648end;
     1649
     1650procedure TCustomImage32.LayerCollectionGetViewportScaleHandler(Sender: TObject;
     1651  out ScaleX, ScaleY: TFloat);
     1652begin
     1653  UpdateCache;
     1654  ScaleX := CachedScaleX;
     1655  ScaleY := CachedScaleY;
     1656end;
     1657
     1658procedure TCustomImage32.LayerCollectionGetViewportShiftHandler(Sender: TObject;
     1659  out ShiftX, ShiftY: TFloat);
     1660begin
     1661  UpdateCache;
     1662  ShiftX := CachedShiftX;
     1663  ShiftY := CachedShiftY;
     1664end;
     1665
    16801666procedure TCustomImage32.Loaded;
    16811667begin
     
    16911677
    16921678  if TabStop and CanFocus then SetFocus;
    1693  
     1679
    16941680  if Layers.MouseEvents then
    16951681    Layer := TLayerCollectionAccess(Layers).MouseDown(Button, Shift, X, Y)
     
    17201706var
    17211707  Layer: TCustomLayer;
    1722 begin
     1708  MouseListener: TCustomLayer;
     1709begin
     1710  MouseListener := TLayerCollectionAccess(Layers).MouseListener;
     1711
    17231712  if Layers.MouseEvents then
    17241713    Layer := TLayerCollectionAccess(Layers).MouseUp(Button, Shift, X, Y)
     
    17271716
    17281717  // unlock the capture using same criteria as was used to acquire it
    1729   if (Button = mbLeft) or (TLayerCollectionAccess(Layers).MouseListener <> nil) then
     1718  if (Button = mbLeft) or ((MouseListener <> nil) and (TLayerCollectionAccess(Layers).MouseListener = nil)) then
    17301719    MouseCapture := False;
    17311720
     
    17361725  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    17371726begin
    1738   if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y, Layer);
     1727  if Assigned(FOnMouseDown) then
     1728    FOnMouseDown(Self, Button, Shift, X, Y, Layer);
    17391729end;
    17401730
     
    17421732  Layer: TCustomLayer);
    17431733begin
    1744   if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X, Y, Layer);
     1734  if Assigned(FOnMouseMove) then
     1735    FOnMouseMove(Self, Shift, X, Y, Layer);
    17451736end;
    17461737
     
    17481739  X, Y: Integer; Layer: TCustomLayer);
    17491740begin
    1750   if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y, Layer);
     1741  if Assigned(FOnMouseUp) then
     1742    FOnMouseUp(Self, Button, Shift, X, Y, Layer);
    17511743end;
    17521744
     
    19331925end;
    19341926
    1935 procedure TCustomImage32.UpdateCache;
    1936 begin
    1937   if CacheValid then Exit;
    1938   CachedBitmapRect := GetBitmapRect;
    1939 
    1940   if Bitmap.Empty then
    1941     SetXForm(0, 0, 1, 1)
    1942   else
    1943     SetXForm(
    1944       CachedBitmapRect.Left, CachedBitmapRect.Top,
    1945       (CachedBitmapRect.Right - CachedBitmapRect.Left) / Bitmap.Width,
    1946       (CachedBitmapRect.Bottom - CachedBitmapRect.Top) / Bitmap.Height
    1947     );
    1948 
    1949   CacheValid := True;
    1950 end;
    1951 
    1952 function TCustomImage32.InvalidRectsAvailable: Boolean;
    1953 begin
    1954   // avoid calling inherited, we have a totally different behaviour here...
    1955   DoPrepareInvalidRects;
    1956   Result := FInvalidRects.Count > 0;
    1957 end;
    1958 
    19591927procedure TCustomImage32.SetRepaintMode(const Value: TRepaintMode);
    19601928begin
     
    19771945  end;
    19781946end;
     1947
     1948procedure TCustomImage32.Update(const Rect: TRect);
     1949begin
     1950  if FRepaintOptimizer.Enabled then
     1951    FRepaintOptimizer.AreaUpdateHandler(Self, Rect, AREAINFO_RECT);
     1952end;
     1953
     1954procedure TCustomImage32.UpdateCache;
     1955begin
     1956  if CacheValid then Exit;
     1957  CachedBitmapRect := GetBitmapRect;
     1958
     1959  if Bitmap.Empty then
     1960    SetXForm(0, 0, 1, 1)
     1961  else
     1962    SetXForm(
     1963      CachedBitmapRect.Left, CachedBitmapRect.Top,
     1964      (CachedBitmapRect.Right - CachedBitmapRect.Left) / Bitmap.Width,
     1965      (CachedBitmapRect.Bottom - CachedBitmapRect.Top) / Bitmap.Height
     1966    );
     1967
     1968  CacheValid := True;
     1969end;
     1970
    19791971
    19801972{ TIVScrollProperties }
     
    24042396  begin
    24052397    if W > Sz.Cx + 2 * ScaledOversize then // Viewport is bigger than scaled Bitmap
    2406       OffsetHorz := (W - Sz.Cx) / 2
     2398      OffsetHorz := (W - Sz.Cx) * 0.5
    24072399    else
    24082400      OffsetHorz := -HScroll.Position + ScaledOversize;
    24092401
    24102402    if H > Sz.Cy + 2 * ScaledOversize then // Viewport is bigger than scaled Bitmap
    2411       OffsetVert := (H - Sz.Cy) / 2
     2403      OffsetVert := (H - Sz.Cy) * 0.5
    24122404    else
    24132405      OffsetVert := -VScroll.Position + ScaledOversize;
  • GraphicTest/Packages/Graphics32/GR32_Layers.pas

    r450 r522  
    6363  TCustomLayer = class;
    6464  TPositionedLayer = class;
     65  TRubberbandLayer = class;
    6566  TLayerClass = class of TCustomLayer;
    6667
     
    111112    function MouseMove(Shift: TShiftState; X, Y: Integer): TCustomLayer;
    112113    function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): TCustomLayer;
     114
    113115    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
    114116    property OnChange: TNotifyEvent read FOnChange write FOnChange;
     
    122124    constructor Create(AOwner: TPersistent);
    123125    destructor Destroy; override;
     126
    124127    function  Add(ItemClass: TLayerClass): TCustomLayer;
    125128    procedure Assign(Source: TPersistent); override;
     
    131134    procedure GetViewportScale(out ScaleX, ScaleY: TFloat); virtual;
    132135    procedure GetViewportShift(out ShiftX, ShiftY: TFloat); virtual;
     136
    133137    property Count: Integer read GetCount;
    134138    property Owner: TPersistent read FOwner;
     
    137141    property MouseEvents: Boolean read FMouseEvents write SetMouseEvents;
    138142  end;
     143
     144{$IFDEF COMPILER2009_UP}
     145  TLayerEnum = class
     146   private
     147     FIndex: Integer;
     148     FLayerCollection: TLayerCollection;
     149   public
     150     constructor Create(ALayerCollection: TLayerCollection);
     151
     152     function GetCurrent: TCustomLayer;
     153     function MoveNext: Boolean;
     154
     155     property Current: TCustomLayer read GetCurrent;
     156   end;
     157
     158   TLayerCollectionHelper = class Helper for TLayerCollection
     159   public
     160     function GetEnumerator: TLayerEnum;
     161   end;
     162{$ENDIF}
    139163
    140164  TLayerState = (lsMouseLeft, lsMouseRight, lsMouseMiddle);
     
    151175    FLayerStates: TLayerStates;
    152176    FLayerOptions: Cardinal;
     177    FTag: Integer;
     178    FClicked: Boolean;
    153179    FOnHitTest: THitTestEvent;
    154180    FOnMouseDown: TMouseEvent;
     
    156182    FOnMouseUp: TMouseEvent;
    157183    FOnPaint: TPaintLayerEvent;
    158     FTag: Integer;
    159184    FOnDestroy: TNotifyEvent;
     185    FOnDblClick: TNotifyEvent;
     186    FOnClick: TNotifyEvent;
    160187    function  GetIndex: Integer;
    161188    function  GetMouseEvents: Boolean;
     
    170197    procedure AddNotification(ALayer: TCustomLayer);
    171198    procedure Changing;
     199    procedure Click;
     200    procedure DblClick;
    172201    function  DoHitTest(X, Y: Integer): Boolean; virtual;
    173202    procedure DoPaint(Buffer: TBitmap32);
     
    184213    procedure SetLayerCollection(Value: TLayerCollection); virtual;
    185214    procedure SetLayerOptions(Value: Cardinal); virtual;
     215
    186216    property Invalid: Boolean read GetInvalid write SetInvalid;
    187217    property ForceUpdate: Boolean read GetForceUpdate write SetForceUpdate;
     
    189219    constructor Create(ALayerCollection: TLayerCollection); virtual;
    190220    destructor Destroy; override;
     221
    191222    procedure BeforeDestruction; override;
    192223    procedure BringToFront;
     
    198229    procedure SendToBack;
    199230    procedure SetAsMouseListener;
     231
    200232    property Cursor: TCursor read FCursor write SetCursor;
    201233    property Index: Integer read GetIndex write SetIndex;
     
    206238    property Tag: Integer read FTag write FTag;
    207239    property Visible: Boolean read GetVisible write SetVisible;
     240
    208241    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    209242    property OnHitTest: THitTestEvent read FOnHitTest write FOnHitTest;
    210243    property OnPaint: TPaintLayerEvent read FOnPaint write FOnPaint;
     244    property OnClick: TNotifyEvent read FOnClick write FOnClick;
     245    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    211246    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    212247    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
     
    225260  public
    226261    constructor Create(ALayerCollection: TLayerCollection); override;
     262
    227263    function GetAdjustedRect(const R: TFloatRect): TFloatRect; virtual;
    228264    function GetAdjustedLocation: TFloatRect;
     265
    229266    property Location: TFloatRect read FLocation write SetLocation;
    230267    property Scaled: Boolean read FScaled write SetScaled;
     
    245282    constructor Create(ALayerCollection: TLayerCollection); override;
    246283    destructor Destroy; override;
     284
    247285    property AlphaHit: Boolean read FAlphaHit write FAlphaHit;
    248286    property Bitmap: TBitmap32 read FBitmap write SetBitmap;
     
    250288  end;
    251289
    252   TDragState = (dsNone, dsMove, dsSizeL, dsSizeT, dsSizeR, dsSizeB,
     290  TRBDragState = (dsNone, dsMove, dsSizeL, dsSizeT, dsSizeR, dsSizeB,
    253291    dsSizeTL, dsSizeTR, dsSizeBL, dsSizeBR);
    254292  TRBHandles = set of (rhCenter, rhSides, rhCorners, rhFrame,
    255293    rhNotLeftSide, rhNotRightSide, rhNotTopSide, rhNotBottomSide,
    256294    rhNotTLCorner, rhNotTRCorner, rhNotBLCorner, rhNotBRCorner);
    257   TRBOptions = set of (roProportional, roConstrained);
     295  TRBOptions = set of (roProportional, roConstrained, roQuantized);
    258296  TRBResizingEvent = procedure(
    259297    Sender: TObject;
    260298    const OldLocation: TFloatRect;
    261299    var NewLocation: TFloatRect;
    262     DragState: TDragState;
     300    DragState: TRBDragState;
    263301    Shift: TShiftState) of object;
    264302  TRBConstrainEvent = TRBResizingEvent;
     303
     304  TRubberbandPassMouse = class(TPersistent)
     305  private
     306    FOwner: TRubberbandLayer;
     307    FEnabled: Boolean;
     308    FToChild: Boolean;
     309    FLayerUnderCursor: Boolean;
     310    FCancelIfPassed: Boolean;
     311  protected
     312    function GetChildUnderCursor(X, Y: Integer): TPositionedLayer;
     313  public
     314    constructor Create(AOwner: TRubberbandLayer);
     315
     316    property Enabled: Boolean read FEnabled write FEnabled default False;
     317    property ToChild: Boolean read FToChild write FToChild default False;
     318    property ToLayerUnderCursor: Boolean read FLayerUnderCursor write FLayerUnderCursor default False;
     319    property CancelIfPassed: Boolean read FCancelIfPassed write FCancelIfPassed default False;
     320  end;
    265321
    266322  TRubberbandLayer = class(TPositionedLayer)
     
    273329    FHandleFill: TColor32;
    274330    FHandles: TRBHandles;
    275     FHandleSize: Integer;
     331    FHandleSize: TFloat;
    276332    FMinWidth: TFloat;
    277333    FMaxHeight: TFloat;
     
    282338    FOnConstrain: TRBConstrainEvent;
    283339    FOptions: TRBOptions;
     340    FQuantized: Integer;
     341    FPassMouse: TRubberbandPassMouse;
    284342    procedure SetFrameStippleStep(const Value: TFloat);
    285343    procedure SetFrameStippleCounter(const Value: TFloat);
     
    288346    procedure SetHandleFrame(Value: TColor32);
    289347    procedure SetHandles(Value: TRBHandles);
    290     procedure SetHandleSize(Value: Integer);
     348    procedure SetHandleSize(Value: TFloat);
    291349    procedure SetOptions(const Value: TRBOptions);
     350    procedure SetQuantized(const Value: Integer);
    292351  protected
    293     IsDragging: Boolean;
    294     DragState: TDragState;
    295     OldLocation: TFloatRect;
    296     MouseShift: TFloatPoint;
     352    FIsDragging: Boolean;
     353    FDragState: TRBDragState;
     354    FOldLocation: TFloatRect;
     355    FMouseShift: TFloatPoint;
    297356    function  DoHitTest(X, Y: Integer): Boolean; override;
    298     procedure DoResizing(var OldLocation, NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState); virtual;
    299     procedure DoConstrain(var OldLocation, NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState); virtual;
     357    procedure DoResizing(var OldLocation, NewLocation: TFloatRect; DragState: TRBDragState; Shift: TShiftState); virtual;
     358    procedure DoConstrain(var OldLocation, NewLocation: TFloatRect; DragState: TRBDragState; Shift: TShiftState); virtual;
    300359    procedure DoSetLocation(const NewLocation: TFloatRect); override;
    301     function  GetDragState(X, Y: Integer): TDragState; virtual;
     360    function  GetDragState(X, Y: Integer): TRBDragState; virtual;
    302361    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    303362    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     
    306365    procedure Paint(Buffer: TBitmap32); override;
    307366    procedure SetLayerOptions(Value: Cardinal); override;
     367    procedure SetDragState(const Value: TRBDragState); overload;
     368    procedure SetDragState(const Value: TRBDragState; const X, Y: Integer); overload;
    308369    procedure UpdateChildLayer;
     370    procedure DrawHandle(Buffer: TBitmap32; X, Y: TFloat); virtual;
    309371  public
    310372    constructor Create(ALayerCollection: TLayerCollection); override;
     373    destructor Destroy; override;
     374
    311375    procedure SetFrameStipple(const Value: Array of TColor32);
     376    procedure Quantize;
     377
    312378    property ChildLayer: TPositionedLayer read FChildLayer write SetChildLayer;
    313379    property Options: TRBOptions read FOptions write SetOptions;
    314380    property Handles: TRBHandles read FHandles write SetHandles;
    315     property HandleSize: Integer read FHandleSize write SetHandleSize;
     381    property HandleSize: TFloat read FHandleSize write SetHandleSize;
    316382    property HandleFill: TColor32 read FHandleFill write SetHandleFill;
    317383    property HandleFrame: TColor32 read FHandleFrame write SetHandleFrame;
     
    322388    property MinHeight: TFloat read FMinHeight write FMinHeight;
    323389    property MinWidth: TFloat read FMinWidth write FMinWidth;
     390    property Quantized: Integer read FQuantized write SetQuantized default 8;
     391    property PassMouseToChild: TRubberbandPassMouse read FPassMouse;
     392
    324393    property OnUserChange: TNotifyEvent read FOnUserChange write FOnUserChange;
    325394    property OnConstrain: TRBConstrainEvent read FOnConstrain write FOnConstrain;
     
    330399
    331400uses
    332   TypInfo, GR32_Image, GR32_LowLevel, GR32_Resamplers, GR32_RepaintOpt;
     401  TypInfo, GR32_Image, GR32_LowLevel, GR32_Resamplers, GR32_RepaintOpt, Types;
    333402
    334403{ mouse state mapping }
     
    375444procedure TLayerCollection.BeginUpdate;
    376445begin
    377   if FUpdateCount = 0 then Changing;
     446  if FUpdateCount = 0 then
     447    Changing;
    378448  Inc(FUpdateCount);
    379449end;
     
    381451procedure TLayerCollection.Changed;
    382452begin
    383   if Assigned(FOnChange) then FOnChange(Self);
     453  if Assigned(FOnChange) then
     454    FOnChange(Self);
    384455end;
    385456
    386457procedure TLayerCollection.Changing;
    387458begin
    388   if Assigned(FOnChanging) then FOnChanging(Self);
     459  if Assigned(FOnChanging) then
     460    FOnChanging(Self);
    389461end;
    390462
     
    415487begin
    416488  FUpdateCount := 1; // disable update notification
    417   if Assigned(FItems) then Clear;
     489  if Assigned(FItems) then
     490    Clear;
    418491  FItems.Free;
    419492  inherited;
     
    423496begin
    424497  Dec(FUpdateCount);
    425   if FUpdateCount = 0 then Changed;
     498  if FUpdateCount = 0 then
     499    Changed;
    426500  Assert(FUpdateCount >= 0, 'Unpaired EndUpdate');
    427501end;
     
    434508  begin
    435509    Result := Items[I];
    436     if (Result.LayerOptions and OptionsMask) = 0 then Continue; // skip to the next one
     510    if (Result.LayerOptions and OptionsMask) = 0 then
     511      Continue; // skip to the next one
    437512    if Result.HitTest(X, Y) then Exit;
    438513  end;
     
    442517procedure TLayerCollection.GDIUpdate;
    443518begin
    444   if (FUpdateCount = 0) and Assigned(FOnGDIUpdate) then FOnGDIUpdate(Self);
     519  if (FUpdateCount = 0) and Assigned(FOnGDIUpdate) then
     520    FOnGDIUpdate(Self);
    445521end;
    446522
     
    538614begin
    539615  Result := MouseListener;
    540   if Result = nil then Result := FindLayerAtPos(X, Y, LOB_MOUSE_EVENTS);
    541   if Assigned(Result) then Result.MouseMove(Shift, X, Y)
    542   else if FOwner is TControl then Screen.Cursor := TControl(FOwner).Cursor;
     616  if Result = nil then
     617    Result := FindLayerAtPos(X, Y, LOB_MOUSE_EVENTS);
     618
     619  if Assigned(Result) then
     620    Result.MouseMove(Shift, X, Y)
     621  else if FOwner is TControl then
     622    Screen.Cursor := TControl(FOwner).Cursor;
    543623end;
    544624
     
    546626begin
    547627  Result := MouseListener;
    548   if Result = nil then Result := FindLayerAtPos(X, Y, LOB_MOUSE_EVENTS);
     628  if Result = nil then
     629    Result := FindLayerAtPos(X, Y, LOB_MOUSE_EVENTS);
    549630
    550631  if Assigned(Result) then
     
    562643procedure TLayerCollection.Notify(Action: TLayerListNotification; Layer: TCustomLayer; Index: Integer);
    563644begin
    564   if Assigned(FOnListNotify) then FOnListNotify(Self, Action, Layer, Index);
     645  if Assigned(FOnListNotify) then
     646    FOnListNotify(Self, Action, Layer, Index);
    565647end;
    566648
     
    607689procedure TLayerCollection.DoUpdateArea(const Rect: TRect);
    608690begin
    609   if Assigned(FOnAreaUpdated) then FOnAreaUpdated(Self, Rect, AREAINFO_RECT);
    610   Changed; 
     691  if Assigned(FOnAreaUpdated) then
     692    FOnAreaUpdated(Self, Rect, AREAINFO_RECT);
     693  Changed;
    611694end;
    612695
    613696procedure TLayerCollection.DoUpdateLayer(Layer: TCustomLayer);
    614697begin
    615   if Assigned(FOnLayerUpdated) then FOnLayerUpdated(Self, Layer);
     698  if Assigned(FOnLayerUpdated) then
     699    FOnLayerUpdated(Self, Layer);
    616700  Changed;
    617701end;
     
    639723end;
    640724
     725
     726{$IFDEF COMPILER2009_UP}
     727{ TLayerEnum }
     728
     729constructor TLayerEnum.Create(ALayerCollection: TLayerCollection);
     730begin
     731  inherited Create;
     732  FLayerCollection := ALayerCollection;
     733  FIndex := -1;
     734end;
     735
     736function TLayerEnum.GetCurrent: TCustomLayer;
     737begin
     738  Result := FLayerCollection.Items[FIndex];
     739end;
     740
     741function TLayerEnum.MoveNext: Boolean;
     742begin
     743  Result := FIndex < Pred(FLayerCollection.Count);
     744  if Result then
     745    Inc(FIndex);
     746end;
     747
     748
     749{ TLayerCollectionHelper }
     750
     751function TLayerCollectionHelper.GetEnumerator: TLayerEnum;
     752begin
     753  Result := TLayerEnum.Create(Self);
     754end;
     755{$ENDIF}
     756
     757
    641758{ TCustomLayer }
    642759
     760constructor TCustomLayer.Create(ALayerCollection: TLayerCollection);
     761begin
     762  LayerCollection := ALayerCollection;
     763  FLayerOptions := LOB_VISIBLE;
     764end;
     765
     766destructor TCustomLayer.Destroy;
     767var
     768  I: Integer;
     769begin
     770  if Assigned(FFreeNotifies) then
     771  begin
     772    for I := FFreeNotifies.Count - 1 downto 0 do
     773    begin
     774      TCustomLayer(FFreeNotifies[I]).Notification(Self);
     775      if FFreeNotifies = nil then Break;
     776    end;
     777    FFreeNotifies.Free;
     778    FFreeNotifies := nil;
     779  end;
     780  SetLayerCollection(nil);
     781  inherited;
     782end;
     783
    643784procedure TCustomLayer.AddNotification(ALayer: TCustomLayer);
    644785begin
    645   if not Assigned(FFreeNotifies) then FFreeNotifies := TList.Create;
    646   if FFreeNotifies.IndexOf(ALayer) < 0 then FFreeNotifies.Add(ALayer);
     786  if not Assigned(FFreeNotifies) then
     787    FFreeNotifies := TList.Create;
     788  if FFreeNotifies.IndexOf(ALayer) < 0 then
     789    FFreeNotifies.Add(ALayer);
    647790end;
    648791
    649792procedure TCustomLayer.BeforeDestruction;
    650793begin
    651   if Assigned(FOnDestroy) then FOnDestroy(Self);
     794  if Assigned(FOnDestroy) then
     795    FOnDestroy(Self);
    652796  inherited;
    653797end;
     
    664808  begin
    665809    Update;
    666     if Visible then FLayerCollection.Changed
     810    if Visible then
     811      FLayerCollection.Changed
    667812    else if (FLayerOptions and LOB_GDI_OVERLAY) <> 0 then
    668813      FLayerCollection.GDIUpdate;
     
    678823  begin
    679824    Update(Rect);
    680     if Visible then FLayerCollection.Changed
     825    if Visible then
     826      FLayerCollection.Changed
    681827    else if (FLayerOptions and LOB_GDI_OVERLAY) <> 0 then
    682828      FLayerCollection.GDIUpdate;
     
    694840end;
    695841
    696 constructor TCustomLayer.Create(ALayerCollection: TLayerCollection);
    697 begin
    698   LayerCollection := ALayerCollection;
    699   FLayerOptions := LOB_VISIBLE;
    700 end;
    701 
    702 destructor TCustomLayer.Destroy;
    703 var
    704   I: Integer;
    705 begin
    706   if Assigned(FFreeNotifies) then
    707   begin
    708     for I := FFreeNotifies.Count - 1 downto 0 do
    709     begin
    710       TCustomLayer(FFreeNotifies[I]).Notification(Self);
    711       if FFreeNotifies = nil then Break;
    712     end;
    713     FFreeNotifies.Free;
    714     FFreeNotifies := nil;
    715   end;
    716   SetLayerCollection(nil);
    717   inherited;
     842procedure TCustomLayer.Click;
     843begin
     844  FClicked := False;
     845  if Assigned(FOnClick) then
     846    FOnClick(Self);
     847end;
     848
     849procedure TCustomLayer.DblClick;
     850begin
     851  FClicked := False;
     852  if Assigned(FOnDblClick) then
     853    FOnDblClick(Self);
    718854end;
    719855
    720856function TCustomLayer.DoHitTest(X, Y: Integer): Boolean;
    721857begin
    722   Result := True;
     858  Result := Visible;
    723859end;
    724860
     
    726862begin
    727863  Paint(Buffer);
    728   if Assigned(FOnPaint) then FOnPaint(Self, Buffer);
     864  if Assigned(FOnPaint) then
     865    FOnPaint(Self, Buffer);
    729866end;
    730867
     
    755892begin
    756893  Result := DoHitTest(X, Y);
    757   if Assigned(FOnHitTest) then FOnHitTest(Self, X, Y, Result);
     894  if Assigned(FOnHitTest) then
     895    FOnHitTest(Self, X, Y, Result);
    758896end;
    759897
    760898procedure TCustomLayer.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    761899begin
    762   if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
     900  if (Button = mbLeft) then
     901  begin
     902    if (ssDouble in Shift) then
     903      DblClick
     904    else
     905      FClicked := True;
     906  end;
     907  if Assigned(FOnMouseDown) then
     908    FOnMouseDown(Self, Button, Shift, X, Y);
    763909end;
    764910
     
    766912begin
    767913  Screen.Cursor := Cursor;
    768   if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X, Y);
     914  if Assigned(FOnMouseMove) then
     915    FOnMouseMove(Self, Shift, X, Y);
    769916end;
    770917
     
    772919begin
    773920  Screen.Cursor := crDefault;
    774   if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y);
     921  if (Button = mbLeft) and FClicked then
     922    Click;
     923  if Assigned(FOnMouseUp) then
     924    FOnMouseUp(Self, Button, Shift, X, Y);
    775925end;
    776926
     
    819969  begin
    820970    FCursor := Value;
    821     if FLayerCollection.MouseListener = Self then Screen.Cursor := Value;
     971    if FLayerCollection.MouseListener = Self then
     972      Screen.Cursor := Value;
    822973  end;
    823974end;
     
    8571008    if Assigned(Value) then
    8581009      Value.InsertItem(Self);
     1010    FLayerCollection := Value;
    8591011  end;
    8601012end;
     
    9481100begin
    9491101  with GetAdjustedRect(FLocation) do
    950     Result := (X >= Left) and (X < Right) and (Y >= Top) and (Y < Bottom);
     1102    Result := (X >= Left) and (X < Right) and (Y >= Top) and (Y < Bottom) and
     1103      inherited DoHitTest(X, Y);
    9511104end;
    9521105
     
    10761229  DstRect := MakeRect(GetAdjustedRect(FLocation));
    10771230  ClipRect := Buffer.ClipRect;
    1078   IntersectRect(TempRect, ClipRect, DstRect);
    1079   if IsRectEmpty(TempRect) then Exit;
     1231  GR32.IntersectRect(TempRect, ClipRect, DstRect);
     1232  if GR32.IsRectEmpty(TempRect) then Exit;
    10801233
    10811234  SrcRect := MakeRect(0, 0, Bitmap.Width, Bitmap.Height);
     
    10901243    if (LayerWidth < 0.5) or (LayerHeight < 0.5) then Exit;
    10911244    ImageRect := TCustomImage32(LayerCollection.FOwner).GetBitmapRect;
    1092     IntersectRect(ClipRect, ClipRect, ImageRect);
     1245    GR32.IntersectRect(ClipRect, ClipRect, ImageRect);
    10931246  end;
    10941247  StretchTransfer(Buffer, DstRect, ClipRect, FBitmap, SrcRect,
     
    11091262  end;
    11101263end;
     1264
     1265
     1266{ TRubberbandPassMouse }
     1267
     1268constructor TRubberbandPassMouse.Create(AOwner: TRubberbandLayer);
     1269begin
     1270  FOwner := AOwner;
     1271  FEnabled := False;
     1272  FToChild := False;
     1273  FLayerUnderCursor := False;
     1274  FCancelIfPassed := False;
     1275end;
     1276
     1277function TRubberbandPassMouse.GetChildUnderCursor(X, Y: Integer): TPositionedLayer;
     1278var
     1279  Layer: TCustomLayer;
     1280  Index: Integer;
     1281begin
     1282  Result := nil;
     1283  for Index := FOwner.LayerCollection.Count - 1 downto 0 do
     1284  begin
     1285    Layer := FOwner.LayerCollection.Items[Index];
     1286    if ((Layer.LayerOptions and LOB_MOUSE_EVENTS) > 0) and
     1287      (Layer is TPositionedLayer) and Layer.HitTest(X, Y) then
     1288    begin
     1289      Result := TPositionedLayer(Layer);
     1290      Exit;
     1291    end;
     1292  end;
     1293end;
     1294
    11111295
    11121296{ TRubberbandLayer }
     
    11211305  FMinWidth := 10;
    11221306  FMinHeight := 10;
     1307  FQuantized := 8;
    11231308  FLayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS;
    11241309  SetFrameStipple([clWhite32, clWhite32, clBlack32, clBlack32]);
     1310  FPassMouse := TRubberbandPassMouse.Create(Self);
    11251311  FFrameStippleStep := 1;
    11261312  FFrameStippleCounter := 0;
    11271313end;
    11281314
     1315destructor TRubberbandLayer.Destroy;
     1316begin
     1317  FPassMouse.Free;
     1318  inherited;
     1319end;
     1320
    11291321function TRubberbandLayer.DoHitTest(X, Y: Integer): Boolean;
    11301322begin
    1131   Result := GetDragState(X, Y) <> dsNone;
     1323  if (Visible) then
     1324    Result := (GetDragState(X, Y) <> dsNone)
     1325  else
     1326    Result := False;
    11321327end;
    11331328
    11341329procedure TRubberbandLayer.DoResizing(var OldLocation,
    1135   NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState);
     1330  NewLocation: TFloatRect; DragState: TRBDragState; Shift: TShiftState);
    11361331begin
    11371332  if Assigned(FOnResizing) then
     
    11401335
    11411336procedure TRubberbandLayer.DoConstrain(var OldLocation,
    1142   NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState);
     1337  NewLocation: TFloatRect; DragState: TRBDragState; Shift: TShiftState);
    11431338begin
    11441339  if Assigned(FOnConstrain) then
     
    11521347end;
    11531348
    1154 function TRubberbandLayer.GetDragState(X, Y: Integer): TDragState;
     1349function TRubberbandLayer.GetDragState(X, Y: Integer): TRBDragState;
    11551350var
    11561351  R: TRect;
     
    11581353  dl, dt, dr, db, dx, dy: Boolean;
    11591354  Sz: Integer;
     1355const
     1356  DragZone = 1;
    11601357begin
    11611358  Result := dsNone;
    1162   Sz := FHandleSize + 1;
     1359  Sz := Ceil(FHandleSize + DragZone);
    11631360  dh_center := rhCenter in FHandles;
    11641361  dh_sides := rhSides in FHandles;
     
    11861383  else if dl and dy and dh_sides and not(rhNotLeftSide in FHandles) then Result := dsSizeL
    11871384  else if dt and dx and dh_sides and not(rhNotTopSide in FHandles) then Result := dsSizeT
    1188   else if dh_center and PtInRect(R, Point(X, Y)) then Result := dsMove;
     1385  else if dh_center and GR32.PtInRect(R, GR32.Point(X, Y)) then Result := dsMove;
    11891386end;
    11901387
    11911388procedure TRubberbandLayer.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    11921389var
    1193   ALoc: TFloatRect;
    1194 begin
    1195   if IsDragging then Exit;
    1196   DragState := GetDragState(X, Y);
    1197   IsDragging := DragState <> dsNone;
    1198   if IsDragging then
    1199   begin
    1200     OldLocation := Location;
    1201 
    1202     ALoc := GetAdjustedRect(FLocation);
    1203     case DragState of
    1204       dsMove: MouseShift := FloatPoint(X - ALoc.Left, Y - ALoc.Top);
     1390  PositionedLayer: TPositionedLayer;
     1391begin
     1392  if FPassMouse.Enabled then
     1393  begin
     1394    if FPassMouse.ToLayerUnderCursor then
     1395      PositionedLayer := FPassMouse.GetChildUnderCursor(X, Y)
    12051396    else
    1206       MouseShift := FloatPoint(0, 0);
    1207     end;
    1208   end;
     1397      PositionedLayer := ChildLayer;
     1398
     1399    if FPassMouse.ToChild and Assigned(ChildLayer) then
     1400    begin
     1401      ChildLayer.MouseDown(Button, Shift, X, Y);
     1402      if FPassMouse.CancelIfPassed then
     1403        Exit;
     1404    end;
     1405
     1406    if (PositionedLayer <> ChildLayer) and Assigned(PositionedLayer) then
     1407    begin
     1408      PositionedLayer.MouseDown(Button, Shift, X, Y);
     1409      if FPassMouse.CancelIfPassed then
     1410        Exit;
     1411    end;
     1412  end;
     1413
     1414  if FIsDragging then Exit;
     1415  SetDragState(GetDragState(X, Y), X, Y);
    12091416  inherited;
    12101417end;
     
    12121419procedure TRubberbandLayer.MouseMove(Shift: TShiftState; X, Y: Integer);
    12131420const
    1214   CURSOR_ID: array [TDragState] of TCursor = (crDefault, crDefault, crSizeWE,
     1421  CURSOR_ID: array [TRBDragState] of TCursor = (crDefault, crDefault, crSizeWE,
    12151422    crSizeNS, crSizeWE, crSizeNS, crSizeNWSE, crSizeNESW, crSizeNESW, crSizeNWSE);
    12161423var
    12171424  Mx, My: TFloat;
    12181425  L, T, R, B, W, H: TFloat;
     1426  Quantize: Boolean;
    12191427  ALoc, NewLocation: TFloatRect;
    12201428
     
    12341442
    12351443begin
    1236   if not IsDragging then
    1237   begin
    1238     DragState := GetDragState(X, Y);
    1239     if DragState = dsMove then Screen.Cursor := Cursor
    1240     else Screen.Cursor := CURSOR_ID[DragState];
     1444  if not FIsDragging then
     1445  begin
     1446    FDragState := GetDragState(X, Y);
     1447    if FDragState = dsMove then
     1448      Screen.Cursor := Cursor
     1449    else
     1450      Screen.Cursor := CURSOR_ID[FDragState];
    12411451  end
    12421452  else
    12431453  begin
    1244     Mx := X - MouseShift.X;
    1245     My := Y - MouseShift.Y;
     1454    Mx := X - FMouseShift.X;
     1455    My := Y - FMouseShift.Y;
    12461456    if Scaled then
    12471457    with Location do
    12481458    begin
    12491459      ALoc := GetAdjustedRect(FLocation);
    1250       if IsRectEmpty(ALoc) then Exit;
     1460      if GR32.IsRectEmpty(ALoc) then Exit;
    12511461      Mx := (Mx - ALoc.Left) / (ALoc.Right - ALoc.Left) * (Right - Left) + Left;
    12521462      My := (My - ALoc.Top) / (ALoc.Bottom - ALoc.Top) * (Bottom - Top) + Top;
    12531463    end;
    12541464
    1255     with OldLocation do
     1465    with FOldLocation do
    12561466    begin
    12571467      L := Left;
     
    12631473    end;
    12641474
    1265     if DragState = dsMove then
     1475    Quantize := (roQuantized in Options) and not (ssAlt in Shift);
     1476
     1477    if FDragState = dsMove then
    12661478    begin
    12671479      L := Mx;
    12681480      T := My;
     1481      if Quantize then
     1482      begin
     1483        L := Round(L / FQuantized) * FQuantized;
     1484        T := Round(T / FQuantized) * FQuantized;
     1485      end;
    12691486      R := L + W;
    12701487      B := T + H;
     
    12721489    else
    12731490    begin
    1274       if DragState in [dsSizeL, dsSizeTL, dsSizeBL] then
     1491      if FDragState in [dsSizeL, dsSizeTL, dsSizeBL] then
     1492      begin
    12751493        IncLT(L, R, Mx - L, MinWidth, MaxWidth);
    1276 
    1277       if DragState in [dsSizeR, dsSizeTR, dsSizeBR] then
     1494        if Quantize then
     1495          L := Round(L / FQuantized) * FQuantized;
     1496      end;
     1497
     1498      if FDragState in [dsSizeR, dsSizeTR, dsSizeBR] then
     1499      begin
    12781500        IncRB(L, R, Mx - R, MinWidth, MaxWidth);
    1279 
    1280       if DragState in [dsSizeT, dsSizeTL, dsSizeTR] then
     1501        if Quantize then
     1502          R := Round(R / FQuantized) * FQuantized;
     1503      end;
     1504
     1505      if FDragState in [dsSizeT, dsSizeTL, dsSizeTR] then
     1506      begin
    12811507        IncLT(T, B, My - T, MinHeight, MaxHeight);
    1282 
    1283       if DragState in [dsSizeB, dsSizeBL, dsSizeBR] then
     1508        if Quantize then
     1509          T := Round(T / FQuantized) * FQuantized;
     1510      end;
     1511
     1512      if FDragState in [dsSizeB, dsSizeBL, dsSizeBR] then
     1513      begin
    12841514        IncRB(T, B, My - B, MinHeight, MaxHeight);
     1515        if Quantize then
     1516          B := Round(B / FQuantized) * FQuantized;
     1517      end;
    12851518    end;
    12861519
     
    12881521
    12891522    if roConstrained in FOptions then
    1290       DoConstrain(OldLocation, NewLocation, DragState, Shift);
     1523      DoConstrain(FOldLocation, NewLocation, FDragState, Shift);
    12911524
    12921525    if roProportional in FOptions then
    12931526    begin
    1294       case DragState of
     1527      case FDragState of
    12951528        dsSizeB, dsSizeBR:
    1296           NewLocation.Right := OldLocation.Left + (OldLocation.Right - OldLocation.Left) * (NewLocation.Bottom - NewLocation.Top) / (OldLocation.Bottom - OldLocation.Top);
     1529          NewLocation.Right := FOldLocation.Left + (FOldLocation.Right - FOldLocation.Left) * (NewLocation.Bottom - NewLocation.Top) / (FOldLocation.Bottom - FOldLocation.Top);
    12971530        dsSizeT, dsSizeTL:
    1298           NewLocation.Left := OldLocation.Right - (OldLocation.Right - OldLocation.Left) * (NewLocation.Bottom - NewLocation.Top) / (OldLocation.Bottom - OldLocation.Top);
     1531          NewLocation.Left := FOldLocation.Right - (FOldLocation.Right - FOldLocation.Left) * (NewLocation.Bottom - NewLocation.Top) / (FOldLocation.Bottom - FOldLocation.Top);
    12991532        dsSizeR, dsSizeBL:
    1300           NewLocation.Bottom := OldLocation.Top + (OldLocation.Bottom - OldLocation.Top) * (NewLocation.Right - NewLocation.Left) / (OldLocation.Right - OldLocation.Left);
     1533          NewLocation.Bottom := FOldLocation.Top + (FOldLocation.Bottom - FOldLocation.Top) * (NewLocation.Right - NewLocation.Left) / (FOldLocation.Right - FOldLocation.Left);
    13011534        dsSizeL, dsSizeTR:
    1302           NewLocation.Top := OldLocation.Bottom - (OldLocation.Bottom - OldLocation.Top) * (NewLocation.Right - NewLocation.Left) / (OldLocation.Right - OldLocation.Left);
     1535          NewLocation.Top := FOldLocation.Bottom - (FOldLocation.Bottom - FOldLocation.Top) * (NewLocation.Right - NewLocation.Left) / (FOldLocation.Right - FOldLocation.Left);
    13031536      end;
    13041537    end;
    13051538
    1306     DoResizing(OldLocation, NewLocation, DragState, Shift);
     1539    DoResizing(FOldLocation, NewLocation, FDragState, Shift);
    13071540
    13081541    if (NewLocation.Left <> Location.Left) or
     
    13121545    begin
    13131546      Location := NewLocation;
    1314       if Assigned(FOnUserChange) then FOnUserChange(Self);
     1547      if Assigned(FOnUserChange) then
     1548        FOnUserChange(Self);
    13151549    end;
    13161550  end;
     
    13181552
    13191553procedure TRubberbandLayer.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    1320 begin
    1321   IsDragging := False;
     1554var
     1555  PositionedLayer: TPositionedLayer;
     1556begin
     1557  if FPassMouse.Enabled then
     1558  begin
     1559    if FPassMouse.ToLayerUnderCursor then
     1560      PositionedLayer := FPassMouse.GetChildUnderCursor(X, Y)
     1561    else
     1562      PositionedLayer := ChildLayer;
     1563
     1564    if FPassMouse.ToChild and Assigned(ChildLayer) then
     1565    begin
     1566      ChildLayer.MouseUp(Button, Shift, X, Y);
     1567      if FPassMouse.CancelIfPassed then
     1568        Exit;
     1569    end;
     1570
     1571    if (PositionedLayer <> ChildLayer) and Assigned(PositionedLayer) then
     1572    begin
     1573      PositionedLayer.MouseUp(Button, Shift, X, Y);
     1574      if FPassMouse.CancelIfPassed then
     1575        Exit;
     1576    end;
     1577  end;
     1578
     1579  FIsDragging := False;
    13221580  inherited;
    13231581end;
     
    13291587end;
    13301588
     1589procedure TRubberbandLayer.DrawHandle(Buffer: TBitmap32; X, Y: TFloat);
     1590var
     1591  HandleRect: TRect;
     1592begin
     1593  // Coordinate specifies exact center of handle. I.e. center of
     1594  // pixel if handle is odd number of pixels wide.
     1595
     1596  HandleRect.Left := Floor(X - FHandleSize);
     1597  HandleRect.Right := HandleRect.Left + Ceil(FHandleSize*2);
     1598  HandleRect.Top := Floor(Y - FHandleSize);
     1599  HandleRect.Bottom := HandleRect.Top + Ceil(FHandleSize*2);
     1600
     1601  Buffer.FrameRectTS(HandleRect, FHandleFrame);
     1602
     1603  GR32.InflateRect(HandleRect, -1, -1);
     1604  Buffer.FillRectTS(HandleRect, FHandleFill);
     1605end;
     1606
    13311607procedure TRubberbandLayer.Paint(Buffer: TBitmap32);
    1332 var
    1333   Cx, Cy: Integer;
     1608
     1609var
     1610  CenterX, CenterY: TFloat;
    13341611  R: TRect;
    1335 
    1336   procedure DrawHandle(X, Y: Integer);
    1337   begin
    1338     Buffer.FillRectTS(X - FHandleSize, Y - FHandleSize, X + FHandleSize, Y + FHandleSize, FHandleFill);
    1339     Buffer.FrameRectTS(X - FHandleSize, Y - FHandleSize, X + FHandleSize, Y + FHandleSize, FHandleFrame);
    1340   end;
    1341 
    13421612begin
    13431613  R := MakeRect(GetAdjustedRect(FLocation));
     
    13541624    if rhCorners in FHandles then
    13551625    begin
    1356       if not(rhNotTLCorner in FHandles) then DrawHandle(Left, Top);
    1357       if not(rhNotTRCorner in FHandles) then DrawHandle(Right, Top);
    1358       if not(rhNotBLCorner in FHandles) then DrawHandle(Left, Bottom);
    1359       if not(rhNotBRCorner in FHandles) then DrawHandle(Right, Bottom);
     1626      if not(rhNotTLCorner in FHandles) then DrawHandle(Buffer, Left+0.5, Top+0.5);
     1627      if not(rhNotTRCorner in FHandles) then DrawHandle(Buffer, Right-0.5, Top+0.5);
     1628      if not(rhNotBLCorner in FHandles) then DrawHandle(Buffer, Left+0.5, Bottom-0.5);
     1629      if not(rhNotBRCorner in FHandles) then DrawHandle(Buffer, Right-0.5, Bottom-0.5);
    13601630    end;
    13611631    if rhSides in FHandles then
    13621632    begin
    1363       Cx := (Left + Right) div 2;
    1364       Cy := (Top + Bottom) div 2;
    1365       if not(rhNotTopSide in FHandles) then DrawHandle(Cx, Top);
    1366       if not(rhNotLeftSide in FHandles) then DrawHandle(Left, Cy);
    1367       if not(rhNotRightSide in FHandles) then DrawHandle(Right, Cy);
    1368       if not(rhNotBottomSide in FHandles) then DrawHandle(Cx, Bottom);
    1369     end;
    1370   end;
     1633      CenterX := (Left + Right) / 2;
     1634      CenterY := (Top + Bottom) / 2;
     1635      if not(rhNotTopSide in FHandles) then DrawHandle(Buffer, CenterX, Top+0.5);
     1636      if not(rhNotLeftSide in FHandles) then DrawHandle(Buffer, Left+0.5, CenterY);
     1637      if not(rhNotRightSide in FHandles) then DrawHandle(Buffer, Right-0.5, CenterY);
     1638      if not(rhNotBottomSide in FHandles) then DrawHandle(Buffer, CenterX, Bottom-0.5);
     1639    end;
     1640  end;
     1641end;
     1642
     1643procedure TRubberbandLayer.Quantize;
     1644begin
     1645  Location := FloatRect(
     1646    Round(Location.Left / Quantized) * Quantized,
     1647    Round(Location.Top / Quantized) * Quantized,
     1648    Round(Location.Right / Quantized) * Quantized,
     1649    Round(Location.Bottom / Quantized) * Quantized);
    13711650end;
    13721651
     
    13851664end;
    13861665
     1666procedure TRubberbandLayer.SetDragState(const Value: TRBDragState);
     1667begin
     1668  SetDragState(Value, 0, 0);
     1669end;
     1670
     1671procedure TRubberbandLayer.SetDragState(const Value: TRBDragState; const X, Y: Integer);
     1672var
     1673  ALoc: TFloatRect;
     1674begin
     1675  FDragState := Value;
     1676  FIsDragging := FDragState <> dsNone;
     1677
     1678  if FIsDragging then
     1679  begin
     1680    FOldLocation := Location;
     1681
     1682    ALoc := GetAdjustedRect(FLocation);
     1683
     1684    case FDragState of
     1685      dsMove: FMouseShift := FloatPoint(X - ALoc.Left, Y - ALoc.Top);
     1686    else
     1687      FMouseShift := FloatPoint(0, 0);
     1688    end;
     1689  end;
     1690end;
     1691
    13871692procedure TRubberbandLayer.SetHandleFill(Value: TColor32);
    13881693begin
     
    14121717end;
    14131718
    1414 procedure TRubberbandLayer.SetHandleSize(Value: Integer);
    1415 begin
    1416   if Value < 1 then Value := 1;
     1719procedure TRubberbandLayer.SetHandleSize(Value: TFloat);
     1720begin
     1721  if Value < 1 then
     1722    Value := 1;
    14171723  if Value <> FHandleSize then
    14181724  begin
     
    14661772end;
    14671773
     1774procedure TRubberbandLayer.SetQuantized(const Value: Integer);
     1775begin
     1776  if Value < 1 then
     1777    raise Exception.Create('Value must be larger than zero!');
     1778
     1779  FQuantized := Value;
     1780end;
     1781
    14681782end.
  • GraphicTest/Packages/Graphics32/GR32_LowLevel.pas

    r450 r522  
    4949
    5050uses
    51   Graphics, GR32, GR32_Math, GR32_System, GR32_Bindings;
     51  Graphics, GR32, GR32_Math;
    5252
    5353{ Clamp function restricts value to [0..255] range }
     
    6868procedure MoveWord(const Source; var Dest; Count: Integer);
    6969
     70{$IFDEF USESTACKALLOC}
    7071{ Allocates a 'small' block of memory on the stack }
    7172function StackAlloc(Size: Integer): Pointer; register;
     
    7374{ Pops memory allocated by StackAlloc }
    7475procedure StackFree(P: Pointer); register;
     76{$ENDIF}
    7577
    7678{ Exchange two 32-bit values }
     
    7981procedure Swap(var A, B: TFixed); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    8082procedure Swap(var A, B: TColor32); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
     83procedure Swap32(var A, B); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
    8184
    8285{ Exchange A <-> B only if B < A }
     
    147150
    148151{ shift right with sign conservation }
     152function SAR_3(Value: Integer): Integer;
    149153function SAR_4(Value: Integer): Integer;
     154function SAR_6(Value: Integer): Integer;
    150155function SAR_8(Value: Integer): Integer;
    151156function SAR_9(Value: Integer): Integer;
     
    162167implementation
    163168
     169uses
    164170{$IFDEF FPC}
    165 uses
    166   SysUtils;
    167 {$ENDIF}
     171  SysUtils,
     172{$ENDIF}
     173  GR32_System, GR32_Bindings;
    168174
    169175{$R-}{$Q-}  // switch off overflow and range checking
     
    172178{$IFDEF USENATIVECODE}
    173179begin
    174  if Value > 255 then Result := 255
    175   else if Value < 0 then Result := 0
    176   else Result := Value;
    177 {$ELSE}
     180 if Value > 255 then
     181   Result := 255
     182 else
     183 if Value < 0 then
     184   Result := 0
     185 else
     186   Result := Value;
     187{$ELSE}
     188{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    178189asm
    179190{$IFDEF TARGET_x64}
     
    202213
    203214{$IFNDEF PUREPASCAL}
    204 procedure FillLongword_ASM(var X; Count: Cardinal; Value: Longword);
     215procedure FillLongword_ASM(var X; Count: Cardinal; Value: Longword); {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    205216asm
    206217{$IFDEF TARGET_x86}
     
    232243end;
    233244
    234 procedure FillLongword_MMX(var X; Count: Cardinal; Value: Longword);
     245procedure FillLongword_MMX(var X; Count: Cardinal; Value: Longword); {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    235246asm
    236247{$IFDEF TARGET_x86}
     
    301312end;
    302313
    303 procedure FillLongword_SSE2(var X; Count: Integer; Value: Longword);
     314procedure FillLongword_SSE2(var X; Count: Integer; Value: Longword); {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    304315asm
    305316{$IFDEF TARGET_x86}
     
    363374{$IFDEF TARGET_x64}
    364375        // RCX = X;   RDX = Count;   R8 = Value
    365         TEST       EDX,EDX    // if Count = 0 then
    366         JZ         @Exit      //   Exit
    367         MOV        RAX, RCX   // RAX = X
    368 
    369         PUSH       RDI        // store RDI on stack
    370         MOV        R9, RDX    // R9 = Count
    371         MOV        RDI, RDX   // RDI = Count
    372 
    373         SHR        RDI, 1     // RDI = RDI SHR 1
    374         SHL        RDI, 1     // RDI = RDI SHL 1
    375         SUB        R9, RDI    // check if extra fill is necessary
    376         JE         @QLoopIni
    377 
    378         MOV        [RAX], R8D // eventually perform extra fill
    379         ADD        RAX, 4     // Inc(X, 4)
    380         DEC        RDX        // Dec(Count)
    381         JZ         @ExitPOP   // if (Count = 0) then Exit
    382 @QLoopIni:
    383         MOVD       XMM0, R8D  // XMM0 = R8D
    384         PUNPCKLDQ  XMM0, XMM0 // unpack XMM0 register
    385         SHR        RDX, 1     // RDX = RDX div 2
    386 @QLoop:
    387         MOVQ       QWORD PTR [RAX], XMM0 // perform fill
    388         ADD        RAX, 8     // Inc(X, 8)
    389         DEC        RDX        // Dec(X);
    390         JNZ        @QLoop
    391         EMMS
    392 @ExitPOP:
    393         POP        RDI
     376
     377        TEST       RDX, RDX        // if Count = 0 then
     378        JZ         @Exit           //   Exit
     379
     380        MOV        R9, RCX         // Point R9 to destination
     381
     382        CMP        RDX, 32
     383        JL         @SmallLoop
     384
     385        AND        RCX, 3          // get aligned count
     386        TEST       RCX, RCX        // check if X is not dividable by 4
     387        JNZ        @SmallLoop      // otherwise perform slow small loop
     388
     389        MOV        RCX, R9
     390        SHR        RCX, 2          // bytes to count
     391        AND        RCX, 3          // get aligned count
     392        ADD        RCX,-4
     393        NEG        RCX             // get count to advance
     394        JZ         @SetupMain
     395        SUB        RDX, RCX        // subtract aligning start from total count
     396
     397@AligningLoop:
     398        MOV        [R9], R8D
     399        ADD        R9, 4
     400        DEC        RCX
     401        JNZ        @AligningLoop
     402
     403@SetupMain:
     404        MOV        RCX, RDX        // RCX = remaining count
     405        SHR        RCX, 2
     406        SHL        RCX, 2
     407        SUB        RDX, RCX        // RDX = remaining count
     408        SHR        RCX, 2
     409
     410        MOVD       XMM0, R8D
     411        PUNPCKLDQ  XMM0, XMM0
     412        PUNPCKLDQ  XMM0, XMM0
     413@SSE2Loop:
     414        MOVDQA     [R9], XMM0
     415        ADD        R9, 16
     416        DEC        RCX
     417        JNZ        @SSE2Loop
     418
     419        TEST       RDX, RDX
     420        JZ         @Exit
     421@SmallLoop:
     422        MOV        [R9], R8D
     423        ADD        R9, 4
     424        DEC        RDX
     425        JNZ        @SmallLoop
    394426@Exit:
    395427{$ENDIF}
     
    407439    P[I] := Value;
    408440{$ELSE}
     441{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    409442asm
    410443{$IFDEF TARGET_x86}
     
    445478  Move(Source, Dest, Count shl 2);
    446479{$ELSE}
     480{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    447481asm
    448482{$IFDEF TARGET_x86}
     
    486520  Move(Source, Dest, Count shl 1);
    487521{$ELSE}
     522{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    488523asm
    489524{$IFDEF TARGET_x86}
     
    557592  A := B;
    558593  B := T;
     594end;
     595
     596procedure Swap32(var A, B);
     597var
     598  T: Integer;
     599begin
     600  T := Integer(A);
     601  Integer(A) := Integer(B);
     602  Integer(B) := T;
    559603end;
    560604
     
    613657    Result := Value;
    614658{$ELSE}
     659{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    615660asm
    616661{$IFDEF TARGET_x64}
     
    651696    Result := C;
    652697{$ELSE}
     698{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    653699asm
    654700{$IFDEF TARGET_x64}
     
    674720    Result := C;
    675721{$ELSE}
     722{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    676723asm
    677724{$IFDEF TARGET_x64}
     
    696743    Result := Value;
    697744{$ELSE}
     745{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    698746asm
    699747{$IFDEF TARGET_x64}
     
    725773    Result := Value;
    726774{$ELSE}
     775{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    727776asm
    728777{$IFDEF TARGET_x64}
     
    743792    Result := Max + (Value - Max) mod (Max + 1)
    744793  else
    745     Result := (Value) mod (Max + 1);
    746 {$ELSE}
     794    Result := Value mod (Max + 1);
     795{$ELSE}
     796{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    747797asm
    748798{$IFDEF TARGET_x64}
     
    776826  Result := FloatMod(Value, Max);
    777827{$ELSE}
     828  if Max = 0 then
     829  begin
     830    Result := 0;
     831    Exit;
     832  end;
     833
    778834  Result := Value;
    779835  while Result >= Max do Result := Result - Max;
     
    788844  Result := Dividend div Divisor;
    789845{$ELSE}
     846{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    790847asm
    791848{$IFDEF TARGET_x86}
     
    826883    Result := Max - Result;
    827884{$ELSE}
     885{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    828886asm
    829887{$IFDEF TARGET_x64}
     
    861919    Inc(Result, Min);
    862920  end;
    863   if Odd(DivResult) then Result := Max+Min-Result;
     921  if Odd(DivResult) then Result := Max + Min - Result;
    864922end;
    865923
     
    9791037
    9801038{ shift right with sign conservation }
     1039function SAR_3(Value: Integer): Integer;
     1040{$IFDEF PUREPASCAL}
     1041begin
     1042  Result := Value div 8;
     1043{$ELSE}
     1044{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
     1045asm
     1046{$IFDEF TARGET_x64}
     1047        MOV       EAX,ECX
     1048{$ENDIF}
     1049        SAR       EAX,3
     1050{$ENDIF}
     1051end;
     1052
    9811053function SAR_4(Value: Integer): Integer;
    982 {$IFDEF USENATIVECODE}
     1054{$IFDEF PUREPASCAL}
    9831055begin
    9841056  Result := Value div 16;
    9851057{$ELSE}
     1058{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    9861059asm
    9871060{$IFDEF TARGET_x64}
     
    9921065end;
    9931066
     1067function SAR_6(Value: Integer): Integer;
     1068{$IFDEF PUREPASCAL}
     1069begin
     1070  Result := Value div 64;
     1071{$ELSE}
     1072{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
     1073asm
     1074{$IFDEF TARGET_x64}
     1075        MOV       EAX,ECX
     1076{$ENDIF}
     1077        SAR       EAX,6
     1078{$ENDIF}
     1079end;
     1080
    9941081function SAR_8(Value: Integer): Integer;
    995 {$IFDEF USENATIVECODE}
     1082{$IFDEF PUREPASCAL}
    9961083begin
    9971084  Result := Value div 256;
    9981085{$ELSE}
     1086{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    9991087asm
    10001088{$IFDEF TARGET_x64}
     
    10061094
    10071095function SAR_9(Value: Integer): Integer;
    1008 {$IFDEF USENATIVECODE}
     1096{$IFDEF PUREPASCAL}
    10091097begin
    10101098  Result := Value div 512;
    10111099{$ELSE}
     1100{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    10121101asm
    10131102{$IFDEF TARGET_x64}
     
    10191108
    10201109function SAR_11(Value: Integer): Integer;
    1021 {$IFDEF USENATIVECODE}
     1110{$IFDEF PUREPASCAL}
    10221111begin
    10231112  Result := Value div 2048;
    10241113{$ELSE}
     1114{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    10251115asm
    10261116{$IFDEF TARGET_x64}
     
    10321122
    10331123function SAR_12(Value: Integer): Integer;
    1034 {$IFDEF USENATIVECODE}
     1124{$IFDEF PUREPASCAL}
    10351125begin
    10361126  Result := Value div 4096;
    10371127{$ELSE}
     1128{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    10381129asm
    10391130{$IFDEF TARGET_x64}
     
    10451136
    10461137function SAR_13(Value: Integer): Integer;
    1047 {$IFDEF USENATIVECODE}
     1138{$IFDEF PUREPASCAL}
    10481139begin
    10491140  Result := Value div 8192;
    10501141{$ELSE}
     1142{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    10511143asm
    10521144{$IFDEF TARGET_x64}
     
    10581150
    10591151function SAR_14(Value: Integer): Integer;
    1060 {$IFDEF USENATIVECODE}
     1152{$IFDEF PUREPASCAL}
    10611153begin
    10621154  Result := Value div 16384;
    10631155{$ELSE}
     1156{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    10641157asm
    10651158{$IFDEF TARGET_x64}
     
    10711164
    10721165function SAR_15(Value: Integer): Integer;
    1073 {$IFDEF USENATIVECODE}
     1166{$IFDEF PUREPASCAL}
    10741167begin
    10751168  Result := Value div 32768;
    10761169{$ELSE}
     1170{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    10771171asm
    10781172{$IFDEF TARGET_x64}
     
    10841178
    10851179function SAR_16(Value: Integer): Integer;
    1086 {$IFDEF USENATIVECODE}
     1180{$IFDEF PUREPASCAL}
    10871181begin
    10881182  Result := Value div 65536;
    10891183{$ELSE}
     1184{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    10901185asm
    10911186{$IFDEF TARGET_x64}
     
    11081203  REn.B := WCEn.R;
    11091204{$ELSE}
     1205{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    11101206asm
    11111207// EAX = WinColor
     
    11211217end;
    11221218
     1219{$IFDEF USESTACKALLOC}
    11231220{$IFDEF PUREPASCAL}
    11241221function StackAlloc(Size: Integer): Pointer;
     
    11381235  x64 implementation by Jameel Halabi
    11391236  }
    1140 function StackAlloc(Size: Integer): Pointer; register;
     1237function StackAlloc(Size: Integer): Pointer; register; {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    11411238asm
    11421239{$IFDEF TARGET_x86}
     
    11631260{$ENDIF}
    11641261{$IFDEF TARGET_x64}
    1165         MOV       RAX, RCX
     1262        {$IFNDEF FPC}
     1263        .NOFRAME
     1264        {$ENDIF}
    11661265        POP       R8           // return address
    11671266        MOV       RDX, RSP     // original SP
    11681267        ADD       ECX, 15
    11691268        AND       ECX, NOT 15  // round up to keep SP dqword aligned
    1170         CMP       ECX, 4092
     1269        CMP       ECX, 4088
    11711270        JLE       @@2
    11721271@@1:
    1173         SUB       RSP, 4092
     1272        SUB       RSP, 4088
    11741273        PUSH      RCX          // make sure we touch guard page, to grow stack
    11751274        SUB       ECX, 4096
     
    11831282        SUB       RDX, 8
    11841283        PUSH      RDX          // save current SP, for sanity check  (sp = [sp])
     1284        PUSH      R8           // return to caller
    11851285{$ENDIF}
    11861286end;
     
    11961296  corrupt the stack. Worst case is that the stack block is not released until
    11971297  the calling routine exits. }
    1198 procedure StackFree(P: Pointer); register;
     1298procedure StackFree(P: Pointer); register; {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    11991299asm
    12001300{$IFDEF TARGET_x86}
    1201         POP       ECX                     { return address }
     1301        POP       ECX                     // return address
    12021302        MOV       EDX, DWORD PTR [ESP]
    12031303        SUB       EAX, 8
    1204         CMP       EDX, ESP                { sanity check #1 (SP = [SP]) }
     1304        CMP       EDX, ESP                // sanity check #1 (SP = [SP])
    12051305        JNE       @Exit
    1206         CMP       EDX, EAX                { sanity check #2 (P = this stack block) }
     1306        CMP       EDX, EAX                // sanity check #2 (P = this stack block)
    12071307        JNE       @Exit
    1208         MOV       ESP, DWORD PTR [ESP+4]  { restore previous SP  }
     1308        MOV       ESP, DWORD PTR [ESP+4]  // restore previous SP
    12091309@Exit:
    1210         PUSH      ECX                     { return to caller }
    1211 {$ENDIF}
    1212 {$IFDEF TARGET_x64}
    1213         POP       R8                       { return address }
     1310        PUSH      ECX                     // return to caller
     1311{$ENDIF}
     1312{$IFDEF TARGET_x64}
     1313        {$IFNDEF FPC}
     1314        .NOFRAME
     1315        {$ENDIF}
     1316        POP       R8                       // return address
    12141317        MOV       RDX, QWORD PTR [RSP]
    12151318        SUB       RCX, 16
    1216         CMP       RDX, RSP                 { sanity check #1 (SP = [SP]) }
     1319        CMP       RDX, RSP                 // sanity check #1 (SP = [SP])
    12171320        JNE       @Exit
    1218         CMP       RDX, RCX                 { sanity check #2 (P = this stack block) }
     1321        CMP       RDX, RCX                 // sanity check #2 (P = this stack block)
    12191322        JNE       @Exit
    1220         MOV       RSP, QWORD PTR [RSP + 8] { restore previous SP  }
     1323        MOV       RSP, QWORD PTR [RSP + 8] // restore previous SP
    12211324 @Exit:
    1222         PUSH      R8                       { return to caller }
    1223 {$ENDIF}
    1224 end;
     1325        PUSH      R8                       // return to caller
     1326{$ENDIF}
     1327end;
     1328{$ENDIF}
    12251329{$ENDIF}
    12261330
  • GraphicTest/Packages/Graphics32/GR32_Math.pas

    r450 r522  
    5959procedure SinCos(const Theta: TFloat; out Sin, Cos: TFloat); overload;
    6060procedure SinCos(const Theta, Radius: Single; out Sin, Cos: Single); overload;
     61procedure SinCos(const Theta, ScaleX, ScaleY: TFloat; out Sin, Cos: Single); overload;
    6162function Hypot(const X, Y: TFloat): TFloat; overload;
    6263function Hypot(const X, Y: Integer): Integer; overload;
     
    8687function FloatMod(x, y: Double): Double; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    8788
     89function DivMod(Dividend, Divisor: Integer; var Remainder: Integer): Integer;
     90
     91
     92{$IFDEF FPC}
     93{$IFDEF TARGET_X64}
     94(*
     95  FPC has no similar {$EXCESSPRECISION OFF} directive,
     96  but we can easily emulate that by overriding some internal math functions
     97*)
     98function PI: Single; [internproc: fpc_in_pi_real];
     99//function Abs(D: Single): Single; [internproc: fpc_in_abs_real];
     100//function Sqr(D: Single): Single; [internproc: fpc_in_sqr_real];
     101function Sqrt(D: Single): Single; [internproc: fpc_in_sqrt_real];
     102function ArcTan(D: Single): Single; [internproc: fpc_in_arctan_real];
     103function Ln(D: Single): Single; [internproc: fpc_in_ln_real];
     104function Sin(D: Single): Single; [internproc: fpc_in_sin_real];
     105function Cos(D: Single): Single; [internproc: fpc_in_cos_real];
     106function Exp(D: Single): Single; [internproc: fpc_in_exp_real];
     107function Round(D: Single): Int64; [internproc: fpc_in_round_real];
     108function Frac(D: Single): Single; [internproc: fpc_in_frac_real];
     109function Int(D: Single): Single; [internproc: fpc_in_int_real];
     110function Trunc(D: Single): Int64; [internproc: fpc_in_trunc_real];
     111
     112function Ceil(X: Single): Integer; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     113function Floor(X: Single): Integer; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     114{$ENDIF}
     115{$ENDIF}
     116
     117type
     118  TCumSumProc = procedure(Values: PSingleArray; Count: Integer);
     119
     120var
     121  CumSum: TCumSumProc;
     122
    88123implementation
    89124
    90125uses
    91   Math;
     126  Math, GR32_System;
    92127
    93128{$IFDEF PUREPASCAL}
     
    96131{$ENDIF}
    97132
     133
     134{$IFDEF FPC}
     135{$IFDEF TARGET_X64}
     136function Ceil(X: Single): Integer;
     137begin
     138  Result := Trunc(X);
     139  if (X - Result) > 0 then
     140    Inc(Result);
     141end;
     142
     143function Floor(X: Single): Integer;
     144begin
     145  Result := Trunc(X);
     146  if (X - Result) < 0 then
     147    Dec(Result);
     148end;
     149{$ENDIF}
     150{$ENDIF}
     151
     152
    98153{ Fixed-point math }
    99154
     
    103158  Result := A div FIXEDONE;
    104159{$ELSE}
     160{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    105161asm
    106162{$IFDEF TARGET_x86}
     
    119175  Result := (A + $FFFF) div FIXEDONE;
    120176{$ELSE}
     177{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    121178asm
    122179{$IFDEF TARGET_x86}
     
    137194  Result := (A + $7FFF) div FIXEDONE;
    138195{$ELSE}
     196{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    139197asm
    140198{$IFDEF TARGET_x86}
     
    155213  Result := Round(A * FixedToFloat * B);
    156214{$ELSE}
     215{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    157216asm
    158217{$IFDEF TARGET_x86}
     
    173232  Result := Round(A / B * FixedOne);
    174233{$ELSE}
     234{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    175235asm
    176236{$IFDEF TARGET_x86}
     
    199259  Result := Round(Dividend / Value);
    200260{$ELSE}
     261{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    201262asm
    202263{$IFDEF TARGET_x86}
     
    219280  Result := Round(Value * FixedToFloat * Value);
    220281{$ELSE}
     282{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    221283asm
    222284{$IFDEF TARGET_x86}
     
    237299  Result := Round(Sqrt(Value * FixedOneS));
    238300{$ELSE}
     301{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    239302asm
    240303{$IFDEF TARGET_x86}
     
    297360  Result := Round(Sqrt(Value * FixedOneS));
    298361{$ELSE}
     362{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    299363asm
    300364{$IFDEF TARGET_x86}
     
    397461  Result := Round(Y + (X - Y) * FixedToFloat * W);
    398462{$ELSE}
     463{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    399464asm
    400465{$IFDEF TARGET_x86}
     
    427492{$IFDEF TARGET_x64}
    428493var
    429   Temp: DWord = 0;
     494  Temp: TFloat;
    430495{$ENDIF}
    431496asm
     
    455520  Cos := C * Radius;
    456521{$ELSE}
     522{$IFDEF TARGET_x64}
     523var
     524  Temp: TFloat;
     525{$ENDIF}
    457526asm
    458527{$IFDEF TARGET_x86}
     
    477546end;
    478547
     548procedure SinCos(const Theta, ScaleX, ScaleY: TFloat; out Sin, Cos: Single); overload;
     549{$IFDEF NATIVE_SINCOS}
     550var
     551  S, C: Extended;
     552begin
     553  Math.SinCos(Theta, S, C);
     554  Sin := S * ScaleX;
     555  Cos := C * ScaleY;
     556{$ELSE}
     557{$IFDEF TARGET_x64}
     558var
     559  Temp: TFloat;
     560{$ENDIF}
     561asm
     562{$IFDEF TARGET_x86}
     563        FLD     Theta
     564        FSINCOS
     565        FMUL    ScaleX
     566        FSTP    DWORD PTR [EDX] // cosine
     567        FMUL    ScaleY
     568        FSTP    DWORD PTR [EAX] // sine
     569{$ENDIF}
     570{$IFDEF TARGET_x64}
     571        MOVD    Temp, Theta
     572        FLD     Temp
     573        FSINCOS
     574        MOVD    Temp, ScaleX
     575        FMUL    Temp
     576        FSTP    [Cos]
     577        MOVD    Temp, ScaleY
     578        FMUL    Temp
     579        FSTP    [Sin]
     580{$ENDIF}
     581{$ENDIF}
     582end;
     583
    479584function Hypot(const X, Y: TFloat): TFloat;
    480585{$IFDEF PUREPASCAL}
     
    482587  Result := Sqrt(Sqr(X) + Sqr(Y));
    483588{$ELSE}
     589{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    484590asm
    485591{$IFDEF TARGET_x86}
     
    534640  J := (I - $3F800000) div 2 + $3F800000;
    535641{$ELSE}
     642{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    536643asm
    537644{$IFDEF TARGET_x86}
     
    552659// see http://en.wikipedia.org/wiki/Methods_of_computing_square_roots#Approximations_that_depend_on_IEEE_representation
    553660// additionally one babylonian step added
     661{$IFNDEF PUREPASCAL}
     662{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
     663{$ENDIF}
    554664const
    555665  CHalf : TFloat = 0.5;
     
    594704 Result := CQuarter * Result + Value / Result;
    595705{$ELSE}
     706{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    596707const
    597708  CHalf : TFloat = 0.5;
     
    616727        DIVSS   XMM0, XMM1
    617728        ADDSS   XMM0, XMM1
    618         MOVD    XMM1, CHalf
     729        MOVD    XMM1, [RIP + CHalf]
    619730        MULSS   XMM0, XMM1
    620731{$ENDIF}
     
    638749  Result := Int64(Multiplicand) * Int64(Multiplier) div Divisor;
    639750{$ELSE}
     751{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    640752asm
    641753{$IFDEF TARGET_x86}
     
    741853    Result := Result shl 1;
    742854{$ELSE}
     855{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    743856asm
    744857{$IFDEF TARGET_x86}
     
    764877    Result := Result shl 1;
    765878{$ELSE}
     879{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    766880asm
    767881{$IFDEF TARGET_x86}
     
    796910  Result := (A and B) + (A xor B) div 2;
    797911{$ELSE}
     912{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    798913asm
    799914{$IFDEF TARGET_x86}
     
    821936  Result := (- Value) shr 31 - (Value shr 31);
    822937{$ELSE}
     938{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
    823939asm
    824940{$IFDEF TARGET_x64}
     
    840956end;
    841957
     958function DivMod(Dividend, Divisor: Integer; var Remainder: Integer): Integer;
     959{$IFDEF PUREPASCAL}
     960begin
     961  Result := Dividend div Divisor;
     962  Remainder := Dividend mod Divisor;
     963{$ELSE}
     964{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
     965asm
     966{$IFDEF TARGET_x86}
     967        PUSH    EDX
     968        CDQ
     969        IDIV    DWORD PTR [ESP]
     970        ADD     ESP, $04
     971        MOV     DWORD PTR [ECX], edx
     972{$ENDIF}
     973{$IFDEF TARGET_x64}
     974        MOV     RAX, RCX
     975        MOV     R9, RDX
     976        CDQ
     977        IDIV    R9
     978        MOV     DWORD PTR [R8], EDX
     979{$ENDIF}
     980{$ENDIF}
     981end;
     982
     983procedure CumSum_Pas(Values: PSingleArray; Count: Integer);
     984var
     985  I: Integer;
     986  V: TFloat;
     987begin
     988  V := Values[0];
     989  for I := 1 to Count - 1 do
     990  begin
     991    if PInteger(@Values[I])^ <> 0 then
     992      V := V + Values[I];
     993    Values[I] := V;
     994  end;
     995end;
     996
     997{$IFNDEF PUREPASCAL}
     998// Aligned SSE2 version -- Credits: Sanyin <prevodilac@hotmail.com>
     999procedure CumSum_SSE2(Values: PSingleArray; Count: Integer); {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
     1000asm
     1001{$IFDEF TARGET_x86}
     1002        MOV     ECX,EDX
     1003        CMP     ECX,2       // if count < 2, exit
     1004        JL      @END
     1005        CMP     ECX,32      // if count < 32, avoid SSE2 overhead
     1006        JL      @SMALL
     1007
     1008{--- align memory ---}
     1009        PUSH    EBX
     1010        PXOR    XMM4,XMM4
     1011        MOV     EBX,EAX
     1012        AND     EBX,15       // get aligned count
     1013        JZ      @ENDALIGNING // already aligned
     1014        ADD     EBX,-16
     1015        NEG     EBX          // get bytes to advance
     1016        JZ      @ENDALIGNING // already aligned
     1017
     1018        MOV     ECX,EBX
     1019        SAR     ECX,2        // div with 4 to get cnt
     1020        SUB     EDX,ECX
     1021
     1022        ADD     EAX,4
     1023        DEC     ECX
     1024        JZ      @SETUPLAST   // one element
     1025
     1026@ALIGNINGLOOP:
     1027        FLD     DWORD PTR [EAX-4]
     1028        FADD    DWORD PTR [EAX]
     1029        FSTP    DWORD PTR [EAX]
     1030        ADD     EAX,4
     1031        DEC     ECX
     1032        JNZ     @ALIGNINGLOOP
     1033
     1034@SETUPLAST:
     1035        MOVUPS  XMM4,[EAX-4]
     1036        PSLLDQ  XMM4,12
     1037        PSRLDQ  XMM4,12
     1038
     1039@ENDALIGNING:
     1040        POP     EBX
     1041        PUSH    EBX
     1042        MOV     ECX,EDX
     1043        SAR     ECX,2
     1044@LOOP:
     1045        MOVAPS  XMM0,[EAX]
     1046        PXOR    XMM5,XMM5
     1047        PCMPEQD XMM5,XMM0
     1048        PMOVMSKB EBX,XMM5
     1049        CMP     EBX,$0000FFFF
     1050        JNE     @NORMAL
     1051        PSHUFD  XMM0,XMM4,0
     1052        JMP     @SKIP
     1053
     1054@NORMAL:
     1055        ADDPS   XMM0,XMM4
     1056        PSHUFD  XMM1,XMM0,$e4
     1057        PSLLDQ  XMM1,4
     1058        PSHUFD  XMM2,XMM1,$90
     1059        PSHUFD  XMM3,XMM1,$40
     1060        ADDPS   XMM2,XMM3
     1061        ADDPS   XMM1,XMM2
     1062        ADDPS   XMM0,XMM1
     1063
     1064        PSHUFLW XMM4,XMM0,$E4
     1065        PSRLDQ  XMM4,12
     1066
     1067@SKIP:
     1068        PREFETCHNTA [eax+16*16*2]
     1069        MOVAPS  [EAX],XMM0
     1070        ADD     EAX,16
     1071        SUB     ECX,1
     1072        JNZ     @LOOP
     1073        POP     EBX
     1074        MOV     ECX,EDX
     1075        SAR     ECX,2
     1076        SHL     ECX,2
     1077        SUB     EDX,ECX
     1078        MOV     ECX,EDX
     1079        JZ      @END
     1080
     1081@LOOP2:
     1082        FLD     DWORD PTR [EAX-4]
     1083        FADD    DWORD PTR [EAX]
     1084        FSTP    DWORD PTR [EAX]
     1085        ADD     EAX,4
     1086        DEC     ECX
     1087        JNZ     @LOOP2
     1088        JMP     @END
     1089
     1090@SMALL:
     1091        MOV     ECX,EDX
     1092        ADD     EAX,4
     1093        DEC     ECX
     1094@LOOP3:
     1095        FLD     DWORD PTR [EAX-4]
     1096        FADD    DWORD PTR [EAX]
     1097        FSTP    DWORD PTR [EAX]
     1098        ADD     EAX,4
     1099        DEC     ECX
     1100        JNZ     @LOOP3
     1101{$ENDIF}
     1102{$IFDEF TARGET_x64}
     1103        CMP     EDX,2       // if count < 2, exit
     1104        JL      @END
     1105
     1106        MOV     RAX,RCX
     1107        MOV     ECX,EDX
     1108
     1109        CMP     ECX,32      // if count < 32, avoid SSE2 overhead
     1110        JL      @SMALL
     1111
     1112{--- align memory ---}
     1113        PXOR    XMM4,XMM4
     1114        MOV     R8D,EAX
     1115        AND     R8D,15       // get aligned count
     1116        JZ      @ENDALIGNING // already aligned
     1117        ADD     R8D,-16
     1118        NEG     R8D          // get bytes to advance
     1119        JZ      @ENDALIGNING // already aligned
     1120
     1121        MOV     ECX,R8D
     1122        SAR     ECX,2        // div with 4 to get cnt
     1123        SUB     EDX,ECX
     1124
     1125        ADD     RAX,4
     1126        DEC     ECX
     1127        JZ      @SETUPLAST   // one element
     1128
     1129@ALIGNINGLOOP:
     1130        FLD     DWORD PTR [RAX - 4]
     1131        FADD    DWORD PTR [RAX]
     1132        FSTP    DWORD PTR [RAX]
     1133        ADD     RAX,4
     1134        DEC     ECX
     1135        JNZ     @ALIGNINGLOOP
     1136
     1137@SETUPLAST:
     1138        MOVUPS  XMM4,[RAX - 4]
     1139        PSLLDQ  XMM4,12
     1140        PSRLDQ  XMM4,12
     1141
     1142@ENDALIGNING:
     1143        MOV     ECX,EDX
     1144        SAR     ECX,2
     1145@LOOP:
     1146        MOVAPS  XMM0,[RAX]
     1147        PXOR    XMM5,XMM5
     1148        PCMPEQD XMM5,XMM0
     1149        PMOVMSKB R8D,XMM5
     1150        CMP     R8D,$0000FFFF
     1151        JNE     @NORMAL
     1152        PSHUFD  XMM0,XMM4,0
     1153        JMP     @SKIP
     1154
     1155@NORMAL:
     1156        ADDPS   XMM0,XMM4
     1157        PSHUFD  XMM1,XMM0,$e4
     1158        PSLLDQ  XMM1,4
     1159        PSHUFD  XMM2,XMM1,$90
     1160        PSHUFD  XMM3,XMM1,$40
     1161        ADDPS   XMM2,XMM3
     1162        ADDPS   XMM1,XMM2
     1163        ADDPS   XMM0,XMM1
     1164
     1165        PSHUFLW XMM4,XMM0,$E4
     1166        PSRLDQ  XMM4,12
     1167
     1168@SKIP:
     1169        PREFETCHNTA [RAX + 32 * 2]
     1170        MOVAPS  [RAX],XMM0
     1171        ADD     RAX,16
     1172        SUB     ECX,1
     1173        JNZ     @LOOP
     1174        MOV     ECX,EDX
     1175        SAR     ECX,2
     1176        SHL     ECX,2
     1177        SUB     EDX,ECX
     1178        MOV     ECX,EDX
     1179        JZ      @END
     1180
     1181@LOOP2:
     1182        FLD     DWORD PTR [RAX - 4]
     1183        FADD    DWORD PTR [RAX]
     1184        FSTP    DWORD PTR [RAX]
     1185        ADD     RAX,4
     1186        DEC     ECX
     1187        JNZ     @LOOP2
     1188        JMP     @END
     1189
     1190@SMALL:
     1191        ADD     RAX,4
     1192        DEC     ECX
     1193@LOOP3:
     1194        FLD     DWORD PTR [RAX - 4]
     1195        FADD    DWORD PTR [RAX]
     1196        FSTP    DWORD PTR [RAX]
     1197        ADD     RAX,4
     1198        DEC     ECX
     1199        JNZ     @LOOP3
     1200{$ENDIF}
     1201@END:
     1202end;
     1203{$ENDIF}
     1204
     1205
     1206initialization
     1207{$IFNDEF PUREPASCAL}
     1208  if HasInstructionSet(ciSSE2) then
     1209    CumSum := CumSum_SSE2
     1210  else
     1211{$ENDIF}
     1212    CumSum := CumSum_Pas;
     1213
    8421214end.
  • GraphicTest/Packages/Graphics32/GR32_MicroTiles.pas

    r450 r522  
    6262{$ENDIF}
    6363  SysUtils, Classes,
    64   GR32, GR32_System, GR32_Containers, GR32_Layers, GR32_RepaintOpt, GR32_Bindings;
     64  GR32, GR32_System, GR32_Containers, GR32_Layers, GR32_RepaintOpt;
    6565
    6666const
     
    242242
    243243uses
    244   GR32_LowLevel, GR32_Math, Math;
     244  GR32_Bindings, GR32_LowLevel, GR32_Math, Math;
    245245
    246246var
  • GraphicTest/Packages/Graphics32/GR32_OrdinalMaps.pas

    r450 r522  
    5454    ctWeightedRGB);
    5555
     56{$IFDEF FPC}
     57  PInteger = ^Integer;
     58{$ENDIF}
     59
    5660  TBooleanMap = class(TCustomMap)
    5761  private
    58     FBits: TArrayOfByte;
    5962    function GetValue(X, Y: Integer): Boolean;
    6063    procedure SetValue(X, Y: Integer; const Value: Boolean);
    61     function GetBits: PByteArray;
    6264  protected
     65    FBits: PByteArray;
    6366    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
    6467  public
     68    constructor Create; overload; override;
    6569    destructor Destroy; override;
     70
    6671    function Empty: Boolean; override;
    6772    procedure Clear(FillValue: Byte);
    6873    procedure ToggleBit(X, Y: Integer);
     74
    6975    property Value[X, Y: Integer]: Boolean read GetValue write SetValue; default;
    70     property Bits: PByteArray read GetBits;
     76    property Bits: PByteArray read FBits;
    7177  end;
    7278
    7379  TByteMap = class(TCustomMap)
    7480  private
    75     FBits: TArrayOfByte;
    7681    function GetValue(X, Y: Integer): Byte; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    7782    function GetValPtr(X, Y: Integer): PByte; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    7883    procedure SetValue(X, Y: Integer; Value: Byte); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    79     function GetBits: PByteArray;
     84    function GetScanline(Y: Integer): PByteArray;
    8085  protected
     86    FBits: PByteArray;
    8187    procedure AssignTo(Dst: TPersistent); override;
    8288    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
    8389  public
     90    constructor Create; overload; override;
    8491    destructor Destroy; override;
     92
    8593    procedure Assign(Source: TPersistent); override;
    86     function  Empty: Boolean; override;
     94    function Empty: Boolean; override;
    8795    procedure Clear(FillValue: Byte);
     96
     97    procedure Multiply(Value: Byte);
     98    procedure Add(Value: Byte);
     99    procedure Sub(Value: Byte);
     100
    88101    procedure ReadFrom(Source: TCustomBitmap32; Conversion: TConversionType);
    89102    procedure WriteTo(Dest: TCustomBitmap32; Conversion: TConversionType); overload;
    90103    procedure WriteTo(Dest: TCustomBitmap32; const Palette: TPalette32); overload;
    91     property Bits: PByteArray read GetBits;
     104
     105    procedure DrawTo(Dest: TCustomBitmap32; X, Y: Integer; Color: TColor32); overload;
     106    procedure DrawTo(Dest: TCustomBitmap32; Rect: TRect; Color: TColor32); overload;
     107
     108    procedure Downsample(Factor: Byte); overload;
     109    procedure Downsample(Dest: TByteMap; Factor: Byte); overload;
     110
     111    procedure FlipHorz(Dst: TByteMap = nil);
     112    procedure FlipVert(Dst: TByteMap = nil);
     113    procedure Rotate90(Dst: TByteMap = nil);
     114    procedure Rotate180(Dst: TByteMap = nil);
     115    procedure Rotate270(Dst: TByteMap = nil);
     116
     117    property Bits: PByteArray read FBits;
     118    property Scanline[Y: Integer]: PByteArray read GetScanline;
    92119    property ValPtr[X, Y: Integer]: PByte read GetValPtr;
    93120    property Value[X, Y: Integer]: Byte read GetValue write SetValue; default;
    94121  end;
    95122
     123  { TWordMap }
     124
    96125  TWordMap = class(TCustomMap)
    97126  private
    98     FBits: TArrayOfWord;
    99127    function GetValPtr(X, Y: Integer): PWord; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    100128    function GetValue(X, Y: Integer): Word; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    101129    procedure SetValue(X, Y: Integer; const Value: Word); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    102     function GetBits: PWordArray;
     130    function GetScanline(Y: Integer): PWordArray;
    103131  protected
     132    FBits: PWordArray;
    104133    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
    105134  public
     135    constructor Create; overload; override;
    106136    destructor Destroy; override;
     137
     138    procedure Assign(Source: TPersistent); override;
    107139    function Empty: Boolean; override;
    108140    procedure Clear(FillValue: Word);
     141
    109142    property ValPtr[X, Y: Integer]: PWord read GetValPtr;
    110143    property Value[X, Y: Integer]: Word read GetValue write SetValue; default;
    111     property Bits: PWordArray read GetBits;
    112   end;
     144    property Bits: PWordArray read FBits;
     145    property Scanline[Y: Integer]: PWordArray read GetScanline;
     146  end;
     147
     148  { TIntegerMap }
    113149
    114150  TIntegerMap = class(TCustomMap)
    115151  private
    116     FBits: TArrayOfInteger;
    117152    function GetValPtr(X, Y: Integer): PInteger; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    118153    function GetValue(X, Y: Integer): Integer; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    119154    procedure SetValue(X, Y: Integer; const Value: Integer); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    120     function GetBits: PIntegerArray;
     155    function GetScanline(Y: Integer): PIntegerArray;
    121156  protected
     157    FBits: PIntegerArray;
    122158    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
    123159  public
     160    constructor Create; overload; override;
    124161    destructor Destroy; override;
     162
     163    procedure Assign(Source: TPersistent); override;
    125164    function Empty: Boolean; override;
    126     procedure Clear(FillValue: Integer);
     165    procedure Clear(FillValue: Integer = 0);
     166
    127167    property ValPtr[X, Y: Integer]: PInteger read GetValPtr;
    128168    property Value[X, Y: Integer]: Integer read GetValue write SetValue; default;
    129     property Bits: PIntegerArray read GetBits;
    130   end;
     169    property Bits: PIntegerArray read FBits;
     170    property Scanline[Y: Integer]: PIntegerArray read GetScanline;
     171  end;
     172
     173  { TCardinalMap }
     174
     175  TCardinalMap = class(TCustomMap)
     176  private
     177    function GetValPtr(X, Y: Cardinal): PCardinal; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     178    function GetValue(X, Y: Cardinal): Cardinal; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     179    procedure SetValue(X, Y: Cardinal; const Value: Cardinal); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     180    function GetScanline(Y: Integer): PCardinalArray;
     181  protected
     182    FBits: PCardinalArray;
     183    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
     184  public
     185    constructor Create; overload; override;
     186    destructor Destroy; override;
     187
     188    procedure Assign(Source: TPersistent); override;
     189    function Empty: Boolean; override;
     190    procedure Clear(FillValue: Cardinal = 0);
     191
     192    property ValPtr[X, Y: Cardinal]: PCardinal read GetValPtr;
     193    property Value[X, Y: Cardinal]: Cardinal read GetValue write SetValue; default;
     194    property Bits: PCardinalArray read FBits;
     195    property Scanline[Y: Integer]: PCardinalArray read GetScanline;
     196  end;
     197
     198  { TFloatMap }
    131199
    132200  TFloatMap = class(TCustomMap)
    133201  private
    134     FBits: TArrayOfFloat;
    135     function GetValPtr(X, Y: Integer): PFloat; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     202    function GetValPtr(X, Y: Integer): GR32.PFloat; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    136203    function GetValue(X, Y: Integer): TFloat; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    137204    procedure SetValue(X, Y: Integer; const Value: TFloat); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
    138     function GetBits: PFloatArray;
     205    function GetScanline(Y: Integer): PFloatArray;
    139206  protected
     207    FBits: PFloatArray;
    140208    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
    141209  public
     210    constructor Create; overload; override;
    142211    destructor Destroy; override;
     212
     213    procedure Assign(Source: TPersistent); override;
    143214    function Empty: Boolean; override;
    144215    procedure Clear; overload;
    145216    procedure Clear(FillValue: TFloat); overload;
     217
    146218    property ValPtr[X, Y: Integer]: PFloat read GetValPtr;
    147219    property Value[X, Y: Integer]: TFloat read GetValue write SetValue; default;
    148     property Bits: PFloatArray read GetBits;
    149   end;
     220    property Bits: PFloatArray read FBits;
     221    property Scanline[Y: Integer]: PFloatArray read GetScanline;
     222  end;
     223
     224{$IFDEF COMPILER2010}
     225
     226  { TGenericMap<T> }
     227
     228  TGenericMap<T> = class(TCustomMap)
     229  private
     230    function GetValue(X, Y: Integer): T; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     231    procedure SetValue(X, Y: Integer; const Value: T); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     232  protected
     233    FBits: Pointer;
     234    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
     235  public
     236    constructor Create; overload; override;
     237    destructor Destroy; override;
     238
     239    procedure Assign(Source: TPersistent); override;
     240    function Empty: Boolean; override;
     241    procedure Clear; overload;
     242    procedure Clear(FillValue: T); overload;
     243
     244    property Value[X, Y: Integer]: T read GetValue write SetValue; default;
     245    property Bits: Pointer read FBits;
     246  end;
     247
     248{$ENDIF}
    150249
    151250implementation
    152251
    153252uses
    154   GR32_LowLevel;
     253  Math, GR32_LowLevel, GR32_Blend, GR32_Resamplers;
     254
     255function Bytes(Bits: Integer): Integer;
     256begin
     257  Result := (Bits - 1) shr 3 + 1;
     258end;
    155259
    156260{ TBooleanMap }
    157261
    158 function Bytes(Bits: Integer): Integer;
    159 begin
    160   Result := (Bits - 1) shr 3 + 1;
     262constructor TBooleanMap.Create;
     263begin
     264  FreeMem(FBits);
     265  inherited Create;
    161266end;
    162267
     
    164269  NewHeight: Integer);
    165270begin
    166   SetLength(FBits, Bytes(NewWidth * NewHeight));
     271  ReallocMem(FBits, Bytes(NewWidth * NewHeight));
    167272  Width := NewWidth;
    168273  Height := NewHeight;
     
    171276procedure TBooleanMap.Clear(FillValue: Byte);
    172277begin
    173   FillChar(FBits[0], Bytes(Width * Height), FillValue);
     278  FillChar(FBits^, Bytes(Width * Height), FillValue);
    174279end;
    175280
     
    185290end;
    186291
    187 function TBooleanMap.GetBits: PByteArray;
    188 begin
    189   Result := @FBits[0];
    190 end;
    191 
    192292function TBooleanMap.GetValue(X, Y: Integer): Boolean;
    193293begin
    194294  X := X + Y * Width;
    195   Result := FBits[X shr 3] and (1 shl (X and 7)) <> 0; //Boolean(FBits[X shr 3] and (1 shl (X and 7)));
     295  Result := FBits^[X shr 3] and (1 shl (X and 7)) <> 0; //Boolean(FBits^[X shr 3] and (1 shl (X and 7)));
    196296end;
    197297
     
    200300  X := Y * Width + X;
    201301  if Value then
    202     FBits[X shr 3] := FBits[X shr 3] or (1 shl (X and 7))
     302    FBits^[X shr 3] := FBits^[X shr 3] or (1 shl (X and 7))
    203303  else
    204     FBits[X shr 3] := FBits[X shr 3] and ((1 shl (X and 7)) xor $FF);
     304    FBits^[X shr 3] := FBits^[X shr 3] and ((1 shl (X and 7)) xor $FF);
    205305end;
    206306
     
    208308begin
    209309  X := Y * Width + X;
    210   FBits[X shr 3] := FBits[X shr 3] xor (1 shl (X and 7));
     310  FBits^[X shr 3] := FBits^[X shr 3] xor (1 shl (X and 7));
    211311end;
    212312
    213313{ TByteMap }
     314
     315constructor TByteMap.Create;
     316begin
     317  FBits := nil;
     318  inherited Create;
     319end;
     320
     321destructor TByteMap.Destroy;
     322begin
     323  FreeMem(FBits);
     324  inherited;
     325end;
     326
     327procedure TByteMap.Downsample(Factor: Byte);
     328begin
     329  // downsample inplace
     330  case Factor of
     331    2:
     332      DownsampleByteMap2x(Self, Self);
     333    3:
     334      DownsampleByteMap3x(Self, Self);
     335    4:
     336      DownsampleByteMap4x(Self, Self);
     337    6:
     338      begin
     339        DownsampleByteMap3x(Self, Self);
     340        DownsampleByteMap2x(Self, Self);
     341      end;
     342    8:
     343      begin
     344        DownsampleByteMap4x(Self, Self);
     345        DownsampleByteMap2x(Self, Self);
     346      end;
     347    9:
     348      begin
     349        DownsampleByteMap3x(Self, Self);
     350        DownsampleByteMap3x(Self, Self);
     351      end;
     352    12:
     353      begin
     354        DownsampleByteMap4x(Self, Self);
     355        DownsampleByteMap3x(Self, Self);
     356      end;
     357    16:
     358      begin
     359        DownsampleByteMap4x(Self, Self);
     360        DownsampleByteMap4x(Self, Self);
     361      end;
     362    18:
     363      begin
     364        DownsampleByteMap3x(Self, Self);
     365        DownsampleByteMap3x(Self, Self);
     366        DownsampleByteMap2x(Self, Self);
     367      end;
     368    24:
     369      begin
     370        DownsampleByteMap4x(Self, Self);
     371        DownsampleByteMap3x(Self, Self);
     372        DownsampleByteMap2x(Self, Self);
     373      end;
     374    27:
     375      begin
     376        DownsampleByteMap3x(Self, Self);
     377        DownsampleByteMap3x(Self, Self);
     378        DownsampleByteMap3x(Self, Self);
     379      end;
     380    32:
     381      begin
     382        DownsampleByteMap4x(Self, Self);
     383        DownsampleByteMap4x(Self, Self);
     384        DownsampleByteMap2x(Self, Self);
     385      end;
     386  end;
     387end;
     388
     389procedure TByteMap.Downsample(Dest: TByteMap; Factor: Byte);
     390
     391  procedure DownsampleAndMove;
     392  var
     393    Temp: TByteMap;
     394    Y: Integer;
     395  begin
     396    // clone destination and downsample inplace
     397    Temp := TByteMap.Create;
     398    Temp.Assign(Self);
     399    Temp.Downsample(Factor);
     400
     401    // copy downsampled result
     402    Dest.SetSize(Width div Factor, Height div Factor);
     403    for Y := 0 to Dest.Height - 1 do
     404      Move(Temp.Scanline[Y]^, Dest.Scanline[Y]^, Dest.Width);
     405  end;
     406
     407begin
     408  // downsample directly
     409  if (Dest = Self) or not (Factor in [2, 3, 4]) then
     410  begin
     411    DownsampleAndMove;
     412    Exit;
     413  end;
     414
     415  case Factor of
     416    2:
     417      begin
     418        Dest.SetSize(Width div 2, Height div 2);
     419        DownsampleByteMap2x(Self, Dest);
     420      end;
     421    3:
     422      begin
     423        // downsample directly
     424        Dest.SetSize(Width div 3, Height div 3);
     425        DownsampleByteMap3x(Self, Dest);
     426      end;
     427    4:
     428      begin
     429        // downsample directly
     430        Dest.SetSize(Width div 4, Height div 4);
     431        DownsampleByteMap4x(Self, Dest);
     432      end;
     433  end;
     434end;
    214435
    215436procedure TByteMap.Assign(Source: TPersistent);
     
    240461procedure TByteMap.ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer);
    241462begin
    242   SetLength(FBits, NewWidth * NewHeight);
     463  ReallocMem(FBits, NewWidth * NewHeight);
    243464  Width := NewWidth;
    244465  Height := NewHeight;
     
    247468procedure TByteMap.Clear(FillValue: Byte);
    248469begin
    249   FillChar(Bits[0], Width * Height, FillValue);
     470  FillChar(Bits^, Width * Height, FillValue);
    250471  Changed;
    251 end;
    252 
    253 destructor TByteMap.Destroy;
    254 begin
    255   FBits := nil;
    256   inherited;
    257472end;
    258473
     
    263478end;
    264479
    265 function TByteMap.GetBits: PByteArray;
    266 begin
    267   Result := @FBits[0];
     480procedure TByteMap.FlipHorz(Dst: TByteMap);
     481var
     482  i, j: Integer;
     483  P1, P2: PByte;
     484  tmp: Byte;
     485  W, W2: Integer;
     486begin
     487  W := Width;
     488  if (Dst = nil) or (Dst = Self) then
     489  begin
     490    { In-place flipping }
     491    P1 := PByte(Bits);
     492    P2 := P1;
     493    Inc(P2, Width - 1);
     494    W2 := Width shr 1;
     495    for J := 0 to Height - 1 do
     496    begin
     497      for I := 0 to W2 - 1 do
     498      begin
     499        tmp := P1^;
     500        P1^ := P2^;
     501        P2^ := tmp;
     502        Inc(P1);
     503        Dec(P2);
     504      end;
     505      Inc(P1, W - W2);
     506      Inc(P2, W + W2);
     507    end;
     508    Changed;
     509  end
     510  else
     511  begin
     512    { Flip to Dst }
     513    Dst.BeginUpdate;
     514    Dst.SetSize(W, Height);
     515    P1 := PByte(Bits);
     516    P2 := PByte(Dst.Bits);
     517    Inc(P2, W - 1);
     518    for J := 0 to Height - 1 do
     519    begin
     520      for I := 0 to W - 1 do
     521      begin
     522        P2^ := P1^;
     523        Inc(P1);
     524        Dec(P2);
     525      end;
     526      Inc(P2, W shl 1);
     527    end;
     528    Dst.EndUpdate;
     529    Dst.Changed;
     530  end;
     531end;
     532
     533procedure TByteMap.FlipVert(Dst: TByteMap);
     534var
     535  J, J2: Integer;
     536  Buffer: PByteArray;
     537  P1, P2: PByte;
     538begin
     539  if (Dst = nil) or (Dst = Self) then
     540  begin
     541    { in-place }
     542    J2 := Height - 1;
     543    GetMem(Buffer, Width);
     544    for J := 0 to Height div 2 - 1 do
     545    begin
     546      P1 := PByte(ScanLine[J]);
     547      P2 := PByte(ScanLine[J2]);
     548      Move(P1^, Buffer^, Width);
     549      Move(P2^, P1^, Width);
     550      Move(Buffer^, P2^, Width);
     551      Dec(J2);
     552    end;
     553    FreeMem(Buffer);
     554    Changed;
     555  end
     556  else
     557  begin
     558    Dst.SetSize(Width, Height);
     559    J2 := Height - 1;
     560    for J := 0 to Height - 1 do
     561    begin
     562      Move(ScanLine[J]^, Dst.ScanLine[J2]^, Width);
     563      Dec(J2);
     564    end;
     565    Dst.Changed;
     566  end;
     567end;
     568
     569function TByteMap.GetScanline(Y: Integer): PByteArray;
     570begin
     571  Result := @FBits^[Y * Width];
    268572end;
    269573
    270574function TByteMap.GetValPtr(X, Y: Integer): PByte;
    271575begin
    272   Result := @FBits[X + Y * Width];
     576  Result := @FBits^[X + Y * Width];
    273577end;
    274578
    275579function TByteMap.GetValue(X, Y: Integer): Byte;
    276580begin
    277   Result := FBits[X + Y * Width];
     581  Result := FBits^[X + Y * Width];
     582end;
     583
     584procedure TByteMap.Multiply(Value: Byte);
     585var
     586  Index: Integer;
     587begin
     588  for Index := 0 to FWidth * FHeight - 1 do
     589    FBits^[Index] := ((FBits^[Index] * Value + $80) shr 8);
     590end;
     591
     592procedure TByteMap.Add(Value: Byte);
     593var
     594  Index: Integer;
     595begin
     596  for Index := 0 to FWidth * FHeight - 1 do
     597    FBits^[Index] := Min(FBits^[Index] + Value, 255);
     598end;
     599
     600procedure TByteMap.Sub(Value: Byte);
     601var
     602  Index: Integer;
     603begin
     604  for Index := 0 to FWidth * FHeight - 1 do
     605    FBits^[Index] := Max(FBits^[Index] + Value, 0);
    278606end;
    279607
     
    295623    SrcC := Source.PixelPtr[0, 0];
    296624    SrcB := Pointer(SrcC);
    297     DstB := @FBits[0];
     625    DstB := @FBits^;
    298626    case Conversion of
    299627
     
    371699end;
    372700
     701procedure TByteMap.Rotate180(Dst: TByteMap);
     702var
     703  Src: PByteArray;
     704  S, D: PByte;
     705  X, Y: Integer;
     706  T: Byte;
     707begin
     708  if (Dst = nil) or (Dst = Self) then
     709  begin
     710    for Y := 0 to FHeight - 1 do
     711    begin
     712      Src := Scanline[Y];
     713      for X := 0 to (FWidth div 2) - 1 do
     714      begin
     715        T := Src^[X];
     716        Src^[X] := Src^[Width - 1 - X];
     717        Src^[Width - 1 - X] := T;
     718      end;
     719    end;
     720  end
     721  else
     722  begin
     723    S := PByte(FBits);
     724    D := PByte(@Dst.Bits[FHeight * FWidth - 1]);
     725    for X := 0 to FHeight * FWidth - 1 do
     726    begin
     727      D^ := S^;
     728      Dec(D);
     729      Inc(S);
     730    end;
     731  end;
     732end;
     733
     734procedure TByteMap.Rotate270(Dst: TByteMap);
     735var
     736  Src: PByteArray;
     737  Current: PByte;
     738  X, Y, W, H: Integer;
     739begin
     740  if (Dst = nil) or (Dst = Self) then
     741  begin
     742    W := FWidth;
     743    H := FHeight;
     744
     745     // inplace replace
     746    GetMem(Src, W * H);
     747
     748    // copy bits
     749    Move(Bits^, Src^, W * H);
     750
     751    SetSize(H, W);
     752
     753    Current := PByte(Src);
     754    for Y := 0 to H - 1 do
     755      for X := 0 to W - 1 do
     756      begin
     757        Bits^[(W - 1 - X) * H + Y] := Current^;
     758        Inc(Current);
     759      end;
     760
     761    // dispose old data pointer
     762    FreeMem(Src);
     763  end
     764  else
     765  begin
     766    // exchange dimensions
     767    Dst.SetSize(Height, Width);
     768
     769    for Y := 0 to FHeight - 1 do
     770    begin
     771      Src := Scanline[Y];
     772      for X := 0 to FWidth - 1 do
     773        Dst.Bits^[X * FHeight + FHeight - 1 - Y] := Src^[X];
     774    end;
     775  end;
     776end;
     777
     778procedure TByteMap.Rotate90(Dst: TByteMap);
     779var
     780  Src: PByteArray;
     781  Current: PByte;
     782  X, Y, W, H: Integer;
     783begin
     784  if (Dst = nil) or (Dst = Self) then
     785  begin
     786    W := FWidth;
     787    H := FHeight;
     788
     789     // inplace replace
     790    GetMem(Src, W * H);
     791
     792    // copy bits
     793    Move(Bits^, Src^, W * H);
     794
     795    SetSize(H, W);
     796
     797    Current := PByte(Src);
     798    for Y := 0 to H - 1 do
     799      for X := 0 to W - 1 do
     800      begin
     801        Bits^[X * H + (H - 1 - Y)] := Current^;
     802        Inc(Current);
     803      end;
     804
     805    // dispose old data pointer
     806    FreeMem(Src);
     807  end
     808  else
     809  begin
     810    // exchange dimensions
     811    Dst.SetSize(Height, Width);
     812
     813    for Y := 0 to FHeight - 1 do
     814    begin
     815      Src := Scanline[Y];
     816      for X := 0 to FWidth - 1 do
     817        Dst.Bits^[(FWidth - 1 - X) * FHeight + Y] := Src^[X];
     818    end;
     819  end;
     820end;
     821
    373822procedure TByteMap.SetValue(X, Y: Integer; Value: Byte);
    374823begin
    375   FBits[X + Y * Width] := Value;
     824  FBits^[X + Y * Width] := Value;
    376825end;
    377826
     
    394843    DstC := Dest.PixelPtr[0, 0];
    395844    DstB := Pointer(DstC);
    396     SrcB := @FBits[0];
     845    SrcB := @FBits^;
    397846    case Conversion of
    398847
     
    472921    N := W * H - 1;
    473922    DstC := Dest.PixelPtr[0, 0];
    474     SrcB := @FBits[0];
     923    SrcB := @FBits^;
    475924
    476925    for I := 0 to N do
     
    485934  end;
    486935end;
    487  
     936
     937procedure TByteMap.DrawTo(Dest: TCustomBitmap32; X, Y: Integer; Color: TColor32);
     938var
     939  ClipRect: TRect;
     940  IX, IY: Integer;
     941  RGB: Cardinal;
     942  NewColor: TColor32;
     943  ScnLn: PColor32Array;
     944  ByteLine: PByteArray;
     945  Alpha: Byte;
     946begin
     947  with ClipRect do
     948  begin
     949    Left := X;
     950    if Left < 0 then
     951      Left := 0;
     952    Top := Y;
     953    if Top < 0 then
     954      Top := 0;
     955    Right := X + Self.Width;
     956    if Right > Self.Width then
     957      Right := Self.Width;
     958    Bottom := Y + Self.Height;
     959    if Bottom > Self.Height then
     960      Bottom := Self.Height;
     961
     962    // split RGB and alpha
     963    RGB := Color and $FFFFFF;
     964    Alpha := Color shr 24;
     965
     966    // blend scanlines
     967    for IY := Top to Bottom - 1 do
     968    begin
     969      ScnLn := Dest.ScanLine[IY];
     970      ByteLine := Self.ScanLine[IY - Y];
     971      for IX := Left to Right - 1 do
     972      begin
     973        NewColor := (((ByteLine^[IX - X] * Alpha) shl 16) and $FF000000) or RGB;
     974        MergeMem(NewColor, ScnLn^[IX]);
     975      end;
     976    end;
     977    EMMS;
     978  end;
     979end;
     980
     981procedure TByteMap.DrawTo(Dest: TCustomBitmap32; Rect: TRect; Color: TColor32);
     982var
     983  ClipRect: TRect;
     984  IX, IY: Integer;
     985  RGB: Cardinal;
     986  NewColor: TColor32;
     987  ScnLn: PColor32Array;
     988  ByteLine: PByteArray;
     989  Alpha: Byte;
     990begin
     991  with ClipRect do
     992  begin
     993    Left := Rect.Left;
     994    if Left < 0 then
     995      Left := 0;
     996    Top := Rect.Top;
     997    if Top < 0 then
     998      Top := 0;
     999    Right := Math.Min(Rect.Left + Self.Width, Rect.Right);
     1000    Bottom := Math.Min(Rect.Top + Self.Height, Rect.Bottom);
     1001
     1002    // split RGB and alpha
     1003    RGB := Color and $FFFFFF;
     1004    Alpha := Color shr 24;
     1005
     1006    // blend scanlines
     1007    for IY := Top to Bottom - 1 do
     1008    begin
     1009      ScnLn := Dest.ScanLine[IY];
     1010      ByteLine := Self.ScanLine[IY - Rect.Top];
     1011      for IX := Left to Right - 1 do
     1012      begin
     1013        NewColor := (((ByteLine^[IX - Rect.Left] * Alpha) shl 16) and $FF000000) or RGB;
     1014        MergeMem(NewColor, ScnLn^[IX]);
     1015      end;
     1016    end;
     1017    EMMS;
     1018  end;
     1019end;
     1020
     1021
    4881022{ TWordMap }
     1023
     1024constructor TWordMap.Create;
     1025begin
     1026  FBits := nil;
     1027  inherited Create;
     1028end;
     1029
     1030destructor TWordMap.Destroy;
     1031begin
     1032  FreeMem(FBits);
     1033  inherited;
     1034end;
    4891035
    4901036procedure TWordMap.ChangeSize(var Width, Height: Integer; NewWidth,
    4911037  NewHeight: Integer);
    4921038begin
    493   SetLength(FBits, NewWidth * NewHeight);
     1039  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(Word));
    4941040  Width := NewWidth;
    4951041  Height := NewHeight;
     
    4981044procedure TWordMap.Clear(FillValue: Word);
    4991045begin
    500   FillWord(FBits[0], Width * Height, FillValue);
     1046  FillWord(FBits^, Width * Height, FillValue);
    5011047  Changed;
    5021048end;
    5031049
    504 destructor TWordMap.Destroy;
     1050procedure TWordMap.Assign(Source: TPersistent);
     1051begin
     1052  BeginUpdate;
     1053    try
     1054      if Source is TWordMap then
     1055      begin
     1056        inherited SetSize(TWordMap(Source).Width, TWordMap(Source).Height);
     1057        Move(TWordMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(Word));
     1058      end
     1059      //else if Source is TBitmap32 then
     1060      //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
     1061      else
     1062        inherited;
     1063    finally
     1064      EndUpdate;
     1065      Changed;
     1066    end;
     1067end;
     1068
     1069function TWordMap.Empty: Boolean;
     1070begin
     1071  Result := not Assigned(FBits);
     1072end;
     1073
     1074function TWordMap.GetScanline(Y: Integer): PWordArray;
     1075begin
     1076  Result := @FBits^[Y * Width];
     1077end;
     1078
     1079function TWordMap.GetValPtr(X, Y: Integer): PWord;
     1080begin
     1081  Result := @FBits^[X + Y * Width];
     1082end;
     1083
     1084function TWordMap.GetValue(X, Y: Integer): Word;
     1085begin
     1086  Result := FBits^[X + Y * Width];
     1087end;
     1088
     1089procedure TWordMap.SetValue(X, Y: Integer; const Value: Word);
     1090begin
     1091  FBits^[X + Y * Width] := Value;
     1092end;
     1093
     1094
     1095{ TIntegerMap }
     1096
     1097constructor TIntegerMap.Create;
    5051098begin
    5061099  FBits := nil;
     1100  inherited Create;
     1101end;
     1102
     1103destructor TIntegerMap.Destroy;
     1104begin
     1105  FreeMem(FBits);
    5071106  inherited;
    5081107end;
    509 
    510 function TWordMap.Empty: Boolean;
    511 begin
    512   Result := not Assigned(FBits);
    513 end;
    514 
    515 function TWordMap.GetBits: PWordArray;
    516 begin
    517   Result := @FBits[0];
    518 end;
    519 
    520 function TWordMap.GetValPtr(X, Y: Integer): PWord;
    521 begin
    522   Result := @FBits[X + Y * Width];
    523 end;
    524 
    525 function TWordMap.GetValue(X, Y: Integer): Word;
    526 begin
    527   Result := FBits[X + Y * Width];
    528 end;
    529 
    530 procedure TWordMap.SetValue(X, Y: Integer; const Value: Word);
    531 begin
    532   FBits[X + Y * Width] := Value;
    533 end;
    534 
    535 { TIntegerMap }
    5361108
    5371109procedure TIntegerMap.ChangeSize(var Width, Height: Integer; NewWidth,
    5381110  NewHeight: Integer);
    5391111begin
    540   SetLength(FBits, NewWidth * NewHeight);
     1112  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(Integer));
    5411113  Width := NewWidth;
    5421114  Height := NewHeight;
     
    5451117procedure TIntegerMap.Clear(FillValue: Integer);
    5461118begin
    547   FillLongword(FBits[0], Width * Height, FillValue);
     1119  FillLongword(FBits^, Width * Height, FillValue);
    5481120  Changed;
    5491121end;
    5501122
    551 destructor TIntegerMap.Destroy;
     1123procedure TIntegerMap.Assign(Source: TPersistent);
     1124begin
     1125  BeginUpdate;
     1126  try
     1127    if Source is TIntegerMap then
     1128    begin
     1129      inherited SetSize(TIntegerMap(Source).Width, TIntegerMap(Source).Height);
     1130      Move(TIntegerMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(Integer));
     1131    end
     1132    //else if Source is TBitmap32 then
     1133    //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
     1134    else
     1135      inherited;
     1136  finally
     1137    EndUpdate;
     1138    Changed;
     1139  end;
     1140end;
     1141
     1142function TIntegerMap.Empty: Boolean;
     1143begin
     1144  Result := not Assigned(FBits);
     1145end;
     1146
     1147function TIntegerMap.GetScanline(Y: Integer): PIntegerArray;
     1148begin
     1149  Result := @FBits^[Y * Width];
     1150end;
     1151
     1152function TIntegerMap.GetValPtr(X, Y: Integer): PInteger;
     1153begin
     1154  Result := @FBits^[X + Y * Width];
     1155end;
     1156
     1157function TIntegerMap.GetValue(X, Y: Integer): Integer;
     1158begin
     1159  Result := FBits^[X + Y * Width];
     1160end;
     1161
     1162procedure TIntegerMap.SetValue(X, Y: Integer; const Value: Integer);
     1163begin
     1164  FBits^[X + Y * Width] := Value;
     1165end;
     1166
     1167
     1168{ TCardinalMap }
     1169
     1170constructor TCardinalMap.Create;
    5521171begin
    5531172  FBits := nil;
     1173  inherited Create;
     1174end;
     1175
     1176destructor TCardinalMap.Destroy;
     1177begin
     1178  FreeMem(FBits);
    5541179  inherited;
    5551180end;
    5561181
    557 function TIntegerMap.Empty: Boolean;
     1182procedure TCardinalMap.Assign(Source: TPersistent);
     1183begin
     1184  BeginUpdate;
     1185  try
     1186    if Source is TCardinalMap then
     1187    begin
     1188      inherited SetSize(TCardinalMap(Source).Width, TCardinalMap(Source).Height);
     1189      Move(TCardinalMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(Cardinal));
     1190    end
     1191    //else if Source is TBitmap32 then
     1192    //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
     1193    else
     1194      inherited;
     1195  finally
     1196    EndUpdate;
     1197    Changed;
     1198  end;
     1199end;
     1200
     1201procedure TCardinalMap.ChangeSize(var Width, Height: Integer; NewWidth,
     1202  NewHeight: Integer);
     1203begin
     1204  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(Cardinal));
     1205  Width := NewWidth;
     1206  Height := NewHeight;
     1207end;
     1208
     1209procedure TCardinalMap.Clear(FillValue: Cardinal);
     1210begin
     1211  FillLongword(FBits^, Width * Height, FillValue);
     1212  Changed;
     1213end;
     1214
     1215function TCardinalMap.Empty: Boolean;
    5581216begin
    5591217  Result := not Assigned(FBits);
    5601218end;
    5611219
    562 function TIntegerMap.GetBits: PIntegerArray;
    563 begin
    564   Result := @FBits[0];
    565 end;
    566 
    567 function TIntegerMap.GetValPtr(X, Y: Integer): PInteger;
    568 begin
    569   Result := @FBits[X + Y * Width];
    570 end;
    571 
    572 function TIntegerMap.GetValue(X, Y: Integer): Integer;
    573 begin
    574   Result := FBits[X + Y * Width];
    575 end;
    576 
    577 procedure TIntegerMap.SetValue(X, Y: Integer; const Value: Integer);
    578 begin
    579   FBits[X + Y * Width] := Value;
    580 end;
     1220function TCardinalMap.GetScanline(Y: Integer): PCardinalArray;
     1221begin
     1222  Result := @FBits^[Y * Width];
     1223end;
     1224
     1225function TCardinalMap.GetValPtr(X, Y: Cardinal): PCardinal;
     1226begin
     1227  Result := @FBits^[X + Y * Cardinal(Width)];
     1228end;
     1229
     1230function TCardinalMap.GetValue(X, Y: Cardinal): Cardinal;
     1231begin
     1232  Result := FBits^[X + Y * Cardinal(Width)];
     1233end;
     1234
     1235procedure TCardinalMap.SetValue(X, Y: Cardinal; const Value: Cardinal);
     1236begin
     1237  FBits^[X + Y * Cardinal(Width)] := Value;
     1238end;
     1239
    5811240
    5821241{ TFloatMap }
     1242
     1243constructor TFloatMap.Create;
     1244begin
     1245  FBits := nil;
     1246  inherited Create;
     1247end;
     1248
     1249destructor TFloatMap.Destroy;
     1250begin
     1251  FreeMem(FBits);
     1252  inherited;
     1253end;
     1254
     1255procedure TFloatMap.Assign(Source: TPersistent);
     1256begin
     1257  BeginUpdate;
     1258  try
     1259    if Source is TFloatMap then
     1260    begin
     1261      inherited SetSize(TFloatMap(Source).Width, TFloatMap(Source).Height);
     1262      Move(TFloatMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(TFloat));
     1263    end
     1264    //else if Source is TBitmap32 then
     1265    //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
     1266    else
     1267      inherited;
     1268  finally
     1269    EndUpdate;
     1270    Changed;
     1271  end;
     1272end;
    5831273
    5841274procedure TFloatMap.ChangeSize(var Width, Height: Integer; NewWidth,
    5851275  NewHeight: Integer);
    5861276begin
    587   SetLength(FBits, NewWidth * NewHeight);
     1277  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(TFloat));
    5881278  Width := NewWidth;
    5891279  Height := NewHeight;
     
    5921282procedure TFloatMap.Clear;
    5931283begin
    594   FillChar(FBits[0], Width * Height * SizeOf(TFloat), 0);
     1284  FillChar(FBits^, Width * Height * SizeOf(TFloat), 0);
    5951285  Changed;
    5961286end;
     
    6011291begin
    6021292  for Index := 0 to Width * Height - 1 do
    603     FBits[Index] := FillValue;
     1293    FBits^[Index] := FillValue;
    6041294  Changed;
    6051295end;
    6061296
    607 destructor TFloatMap.Destroy;
     1297function TFloatMap.Empty: Boolean;
     1298begin
     1299  Result := not Assigned(FBits);
     1300end;
     1301
     1302function TFloatMap.GetScanline(Y: Integer): PFloatArray;
     1303begin
     1304  Result := @FBits^[Y * Width];
     1305end;
     1306
     1307function TFloatMap.GetValPtr(X, Y: Integer): GR32.PFloat;
     1308begin
     1309  Result := @FBits^[X + Y * Width];
     1310end;
     1311
     1312function TFloatMap.GetValue(X, Y: Integer): TFloat;
     1313begin
     1314  Result := FBits^[X + Y * Width];
     1315end;
     1316
     1317procedure TFloatMap.SetValue(X, Y: Integer; const Value: TFloat);
     1318begin
     1319  FBits^[X + Y * Width] := Value;
     1320end;
     1321
     1322
     1323{$IFDEF COMPILER2010}
     1324
     1325{ TGenericMap<T> }
     1326
     1327constructor TGenericMap<T>.Create;
    6081328begin
    6091329  FBits := nil;
     1330  inherited Create;
     1331end;
     1332
     1333destructor TGenericMap<T>.Destroy;
     1334begin
     1335  FreeMem(FBits);
    6101336  inherited;
    6111337end;
    6121338
    613 function TFloatMap.Empty: Boolean;
     1339procedure TGenericMap<T>.Assign(Source: TPersistent);
     1340begin
     1341  BeginUpdate;
     1342  try
     1343(*
     1344    if Source is TFloatMap then
     1345    begin
     1346      inherited SetSize(TFloatMap(Source).Width, TFloatMap(Source).Height);
     1347      Move(TFloatMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(TFloat));
     1348    end
     1349    //else if Source is TBitmap32 then
     1350    //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
     1351    else
     1352      inherited;
     1353*)
     1354  finally
     1355    EndUpdate;
     1356    Changed;
     1357  end;
     1358end;
     1359
     1360procedure TGenericMap<T>.ChangeSize(var Width, Height: Integer; NewWidth,
     1361  NewHeight: Integer);
     1362begin
     1363  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(T));
     1364  Width := NewWidth;
     1365  Height := NewHeight;
     1366end;
     1367
     1368procedure TGenericMap<T>.Clear(FillValue: T);
     1369var
     1370  Index: Integer;
     1371begin
     1372  for Index := 0 to Width * Height - 1 do
     1373    Move(FillValue, PByte(FBits)[Index], SizeOf(T));
     1374  Changed;
     1375end;
     1376
     1377procedure TGenericMap<T>.Clear;
     1378begin
     1379  FillChar(FBits^, Width * Height * SizeOf(T), 0);
     1380  Changed;
     1381end;
     1382
     1383function TGenericMap<T>.Empty: Boolean;
    6141384begin
    6151385  Result := not Assigned(FBits);
    6161386end;
    6171387
    618 function TFloatMap.GetBits: PFloatArray;
    619 begin
    620   Result := @FBits[0];
    621 end;
    622 
    623 function TFloatMap.GetValPtr(X, Y: Integer): PFloat;
    624 begin
    625   Result := @FBits[X + Y * Width];
    626 end;
    627 
    628 function TFloatMap.GetValue(X, Y: Integer): TFloat;
    629 begin
    630   Result := FBits[X + Y * Width];
    631 end;
    632 
    633 procedure TFloatMap.SetValue(X, Y: Integer; const Value: TFloat);
    634 begin
    635   FBits[X + Y * Width] := Value;
    636 end;
     1388function TGenericMap<T>.GetValue(X, Y: Integer): T;
     1389begin
     1390  Move(PByte(FBits)[(X + Y * Width) * SizeOf(T)], Result, SizeOf(T));
     1391end;
     1392
     1393procedure TGenericMap<T>.SetValue(X, Y: Integer; const Value: T);
     1394begin
     1395  Move(Value, PByte(FBits)[(X + Y * Width) * SizeOf(T)], SizeOf(T));
     1396end;
     1397
     1398{$ENDIF}
    6371399
    6381400end.
  • GraphicTest/Packages/Graphics32/GR32_Polygons.pas

    r450 r522  
    2121 * license.
    2222 *
    23  * The Original Code is Graphics32
     23 * The Original Code is Vectorial Polygon Rasterizer for Graphics32
    2424 *
    2525 * The Initial Developer of the Original Code is
    26  * Alex A. Denisov
     26 * Mattias Andersson <mattias@centaurix.com>
    2727 *
    28  * Portions created by the Initial Developer are Copyright (C) 2000-2009
     28 * Portions created by the Initial Developer are Copyright (C) 2008-2012
    2929 * the Initial Developer. All Rights Reserved.
    3030 *
    3131 * Contributor(s):
    32  *   Andre Beckedorf <Andre@metaException.de>
    33  *   Mattias Andersson <mattias@centaurix.com>
    34  *   Peter Larson <peter@larson.net>
    3532 *
    3633 * ***** END LICENSE BLOCK ***** *)
     
    4037{$I GR32.inc}
    4138
    42 {$IFDEF PUREPASCAL}
    43 {$DEFINE USENATIVECODE}
    44 {$ENDIF}
    45 {$IFDEF USEINLINING}
    46 {$DEFINE USENATIVECODE}
    47 {$ENDIF}
    48 
    4939uses
    50 {$IFDEF FPC}
    51 {$ELSE}
    52   Windows,
    53 {$ENDIF}
    54   Classes, SysUtils, GR32, GR32_LowLevel, GR32_Blend, GR32_Transforms,
    55   GR32_Resamplers, GR32_Math;
    56 
    57 { Polylines }
    58 
    59 procedure PolylineTS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    60   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
    61 procedure PolylineAS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    62   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
    63 procedure PolylineXS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    64   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
    65 procedure PolylineXSP(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    66   Closed: Boolean = False; Transformation: TTransformation = nil);
    67 
    68 procedure PolyPolylineTS(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    69   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
    70 procedure PolyPolylineAS(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    71   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
    72 procedure PolyPolylineXS(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    73   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
    74 procedure PolyPolylineXSP(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    75   Closed: Boolean = False; Transformation: TTransformation = nil);
    76 
    77 { Polygons }
     40  Types, GR32, GR32_Containers, GR32_VPR, GR32_Transforms, GR32_Resamplers;
    7841
    7942type
    80   TPolyFillMode = (pfAlternate, pfWinding);
    81   TAntialiasMode = (am32times, am16times, am8times, am4times, am2times, amNone);
    82 
    83   TFillLineEvent = procedure(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32) of object;
     43  { Polygon join style - used by GR32_VectorUtils.Grow(). }
     44  { nb: jsRoundEx rounds both convex and concave joins unlike jsRound which
     45    only rounds convex joins. The depth of convex join rounding is controlled
     46    by Grow's MiterLimit parameter }
     47  TJoinStyle = (jsMiter, jsBevel, jsRound, jsRoundEx);
     48
     49  { Polygon end style }
     50  TEndStyle = (esButt, esSquare, esRound);
     51
     52  { Polygon fill mode }
     53  TPolyFillMode = (pfAlternate, pfWinding, pfEvenOdd = 0, pfNonZero);
     54
     55  { TCustomPolygonRenderer }
     56  TCustomPolygonRenderer = class(TThreadPersistent)
     57  public
     58    procedure PolyPolygonFS(const Points: TArrayOfArrayOfFloatPoint;
     59      const ClipRect: TFloatRect; Transformation: TTransformation); overload; virtual;
     60    procedure PolyPolygonFS(const Points: TArrayOfArrayOfFloatPoint;
     61      const ClipRect: TFloatRect); overload; virtual;
     62    procedure PolygonFS(const Points: TArrayOfFloatPoint;
     63      const ClipRect: TFloatRect; Transformation: TTransformation); overload; virtual;
     64    procedure PolygonFS(const Points: TArrayOfFloatPoint;
     65      const ClipRect: TFloatRect); overload; virtual;
     66
     67    // procedure PolyPolygonXS(const Points: TArrayOfArrayOfFixedPoint; const ClipRect: TFixedRect; Transformation: TTransformation); virtual; overload;
     68    // procedure PolyPolygonXS(const Points: TArrayOfArrayOfFixedPoint; const ClipRect: TFixedRect); virtual; overload;
     69  end;
     70  TCustomPolygonRendererClass = class of TCustomPolygonRenderer;
     71
     72  TCustomPolygonFiller = class;
     73
     74  { TPolygonRenderer32 }
     75  TPolygonRenderer32 = class(TCustomPolygonRenderer)
     76  private
     77    FBitmap: TBitmap32;
     78    FFillMode: TPolyFillMode;
     79    FColor: TColor32;
     80    FFiller: TCustomPolygonFiller;
     81    procedure SetColor(const Value: TColor32);
     82    procedure SetFillMode(const Value: TPolyFillMode);
     83    procedure SetFiller(const Value: TCustomPolygonFiller);
     84  protected
     85    procedure SetBitmap(const Value: TBitmap32); virtual;
     86  public
     87    constructor Create(Bitmap: TBitmap32; Fillmode: TPolyFillMode = pfWinding); reintroduce; overload;
     88    procedure PolygonFS(const Points: TArrayOfFloatPoint); overload; virtual;
     89    procedure PolyPolygonFS(const Points: TArrayOfArrayOfFloatPoint); overload; virtual;
     90
     91    property Bitmap: TBitmap32 read FBitmap write SetBitmap;
     92    property FillMode: TPolyFillMode read FFillMode write SetFillMode;
     93    property Color: TColor32 read FColor write SetColor;
     94    property Filler: TCustomPolygonFiller read FFiller write SetFiller;
     95  end;
     96  TPolygonRenderer32Class = class of TPolygonRenderer32;
     97
     98  { TPolygonRenderer32VPR }
     99  { Polygon renderer based on VPR. Computes exact coverages for optimal anti-aliasing. }
     100  TFillProc = procedure(Coverage: PSingleArray; AlphaValues: PColor32Array; Count: Integer; Color: TColor32);
     101
     102  TPolygonRenderer32VPR = class(TPolygonRenderer32)
     103  private
     104    FFillProc: TFillProc;
     105    procedure UpdateFillProcs;
     106  protected
     107    procedure RenderSpan(const Span: TValueSpan; DstY: Integer); virtual;
     108    procedure FillSpan(const Span: TValueSpan; DstY: Integer); virtual;
     109    function GetRenderSpan: TRenderSpanEvent; virtual;
     110  public
     111    procedure PolyPolygonFS(const Points: TArrayOfArrayOfFloatPoint;
     112      const ClipRect: TFloatRect); override;
     113  end;
     114
     115  { TPolygonRenderer32LCD }
     116  TPolygonRenderer32LCD = class(TPolygonRenderer32VPR)
     117  protected
     118    procedure RenderSpan(const Span: TValueSpan; DstY: Integer); override;
     119  public
     120    procedure PolyPolygonFS(const Points: TArrayOfArrayOfFloatPoint;
     121      const ClipRect: TFloatRect); override;
     122  end;
     123
     124  { TPolygonRenderer32LCD2 }
     125  TPolygonRenderer32LCD2 = class(TPolygonRenderer32LCD)
     126  public
     127    procedure RenderSpan(const Span: TValueSpan; DstY: Integer); override;
     128  end;
     129
     130  { TCustomPolygonFiller }
     131
     132  TFillLineEvent = procedure(Dst: PColor32; DstX, DstY, Length: Integer;
     133    AlphaValues: PColor32; CombineMode: TCombineMode) of object;
    84134
    85135  TCustomPolygonFiller = class
     
    87137    function GetFillLine: TFillLineEvent; virtual; abstract;
    88138  public
     139    procedure BeginRendering; virtual;
     140    procedure EndRendering; virtual;
     141
    89142    property FillLine: TFillLineEvent read GetFillLine;
    90143  end;
    91144
    92 const
    93   DefaultAAMode = am8times; // Use 54 levels of transparency for antialiasing.
    94 
    95 procedure PolygonTS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    96   Color: TColor32; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
    97 procedure PolygonTS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    98   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
    99 procedure PolygonTS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    100   Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
    101 
    102 procedure PolygonXS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    103   Color: TColor32; Mode: TPolyFillMode = pfAlternate;
    104   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
    105 procedure PolygonXS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    106   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate;
    107   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
    108 procedure PolygonXS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    109   Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate;
    110   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
    111 
    112 procedure PolyPolygonTS(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    113   Color: TColor32; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
    114 procedure PolyPolygonTS(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    115   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
    116 procedure PolyPolygonTS(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    117   Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
    118 
    119 procedure PolyPolygonXS(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    120   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate;
    121   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
    122 procedure PolyPolygonXS(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    123   Color: TColor32; Mode: TPolyFillMode = pfAlternate;
    124   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
    125 procedure PolyPolygonXS(Bitmap: TCustomBitmap32; const Points: TArrayOfArrayOfFixedPoint;
    126   Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate;
    127   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
    128 
    129 function PolygonBounds(const Points: TArrayOfFixedPoint; Transformation: TTransformation = nil): TFixedRect;
    130 function PolyPolygonBounds(const Points: TArrayOfArrayOfFixedPoint; Transformation: TTransformation = nil): TFixedRect;
    131 
    132 function PtInPolygon(const Pt: TFixedPoint; const Points: TArrayOfFixedPoint): Boolean;
    133 
    134 { TPolygon32 }
    135 { TODO : Bezier Curves, and QSpline curves for TrueType font rendering }
    136 { TODO : Check if QSpline is compatible with Type1 fonts }
    137 type
    138   TPolygon32 = class(TThreadPersistent)
     145  { TCallbackPolygonFiller }
     146  TCallbackPolygonFiller = class(TCustomPolygonFiller)
    139147  private
    140     FAntialiased: Boolean;
    141     FClosed: Boolean;
    142     FFillMode: TPolyFillMode;
    143     FNormals: TArrayOfArrayOfFixedPoint;
    144     FPoints: TArrayOfArrayOfFixedPoint;
    145     FAntialiasMode: TAntialiasMode;
     148    FFillLineEvent: TFillLineEvent;
    146149  protected
    147     procedure BuildNormals;
    148     procedure CopyPropertiesTo(Dst: TPolygon32); virtual;
    149     procedure AssignTo(Dst: TPersistent); override;
     150    function GetFillLine: TFillLineEvent; override;
    150151  public
    151     constructor Create; override;
    152     destructor Destroy; override;
    153     procedure Add(const P: TFixedPoint);
    154     procedure AddPoints(var First: TFixedPoint; Count: Integer);
    155     function  ContainsPoint(const P: TFixedPoint): Boolean;
    156     procedure Clear;
    157     function  Grow(const Delta: TFixed; EdgeSharpness: Single = 0): TPolygon32;
    158 
    159     procedure Draw(Bitmap: TCustomBitmap32; OutlineColor, FillColor: TColor32; Transformation: TTransformation = nil); overload;
    160     procedure Draw(Bitmap: TCustomBitmap32; OutlineColor: TColor32; FillCallback: TFillLineEvent; Transformation: TTransformation = nil); overload;
    161     procedure Draw(Bitmap: TCustomBitmap32; OutlineColor: TColor32; Filler: TCustomPolygonFiller; Transformation: TTransformation = nil); overload;
    162 
    163     procedure DrawEdge(Bitmap: TCustomBitmap32; Color: TColor32; Transformation: TTransformation = nil);
    164 
    165     procedure DrawFill(Bitmap: TCustomBitmap32; Color: TColor32; Transformation: TTransformation = nil); overload;
    166     procedure DrawFill(Bitmap: TCustomBitmap32; FillCallback: TFillLineEvent; Transformation: TTransformation = nil); overload;
    167     procedure DrawFill(Bitmap: TCustomBitmap32; Filler: TCustomPolygonFiller; Transformation: TTransformation = nil); overload;
    168 
    169     procedure NewLine;
    170     procedure Offset(const Dx, Dy: TFixed);
    171     function  Outline: TPolygon32;
    172     procedure Transform(Transformation: TTransformation);
    173     function GetBoundingRect: TFixedRect;
    174 
    175     property Antialiased: Boolean read FAntialiased write FAntialiased;
    176     property AntialiasMode: TAntialiasMode read FAntialiasMode write FAntialiasMode;
    177     property Closed: Boolean read FClosed write FClosed;
    178     property FillMode: TPolyFillMode read FFillMode write FFillMode;
    179 
    180     property Normals: TArrayOfArrayOfFixedPoint read FNormals write FNormals;
    181     property Points: TArrayOfArrayOfFixedPoint read FPoints write FPoints;
     152    property FillLineEvent: TFillLineEvent read FFillLineEvent write FFillLineEvent;
     153  end;
     154
     155  { TInvertPolygonFiller }
     156  TInvertPolygonFiller = class(TCustomPolygonFiller)
     157  protected
     158    function GetFillLine: TFillLineEvent; override;
     159    procedure FillLineBlend(Dst: PColor32; DstX, DstY, Length: Integer;
     160      AlphaValues: PColor32; CombineMode: TCombineMode);
     161  end;
     162
     163  { TClearPolygonFiller }
     164  TClearPolygonFiller = class(TCustomPolygonFiller)
     165  private
     166    FColor: TColor32;
     167  protected
     168    function GetFillLine: TFillLineEvent; override;
     169    procedure FillLineClear(Dst: PColor32; DstX, DstY,
     170      Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
     171  public
     172    constructor Create(Color: TColor32 = $00808080); reintroduce; virtual;
     173
     174    property Color: TColor32 read FColor write FColor;
    182175  end;
    183176
     
    190183  protected
    191184    function GetFillLine: TFillLineEvent; override;
    192     procedure FillLineOpaque(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
    193     procedure FillLineBlend(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
    194     procedure FillLineBlendMasterAlpha(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
    195     procedure FillLineCustomCombine(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
     185    procedure FillLineOpaque(Dst: PColor32; DstX, DstY,
     186      Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
     187    procedure FillLineBlend(Dst: PColor32; DstX, DstY,
     188      Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
     189    procedure FillLineBlendMasterAlpha(Dst: PColor32; DstX, DstY,
     190      Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
     191    procedure FillLineCustomCombine(Dst: PColor32; DstX, DstY,
     192      Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
    196193  public
    197194    property Pattern: TCustomBitmap32 read FPattern write FPattern;
     
    207204    procedure SetSampler(const Value: TCustomSampler);
    208205  protected
     206    procedure SamplerChanged; virtual;
    209207    function GetFillLine: TFillLineEvent; override;
    210     procedure SampleLineOpaque(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
    211 
     208    procedure SampleLineOpaque(Dst: PColor32; DstX, DstY, Length: Integer;
     209      AlphaValues: PColor32; CombineMode: TCombineMode);
     210  public
     211    constructor Create(Sampler: TCustomSampler = nil); reintroduce; virtual;
     212    procedure BeginRendering; override;
     213    procedure EndRendering; override;
    212214    property Sampler: TCustomSampler read FSampler write SetSampler;
    213215  end;
    214    
     216
     217procedure PolyPolygonFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     218  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     219  Transformation: TTransformation = nil); overload;
     220procedure PolygonFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     221  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     222  Transformation: TTransformation = nil); overload;
     223procedure PolyPolygonFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     224  Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
     225  Transformation: TTransformation = nil); overload;
     226procedure PolygonFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     227  Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
     228  Transformation: TTransformation = nil); overload;
     229procedure PolyPolygonFS_LCD(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     230  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     231  Transformation: TTransformation = nil); overload;
     232procedure PolygonFS_LCD(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     233  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     234  Transformation: TTransformation = nil); overload;
     235procedure PolyPolygonFS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     236  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     237  Transformation: TTransformation = nil); overload;
     238procedure PolygonFS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     239  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     240  Transformation: TTransformation = nil); overload;
     241
     242procedure PolyPolygonFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     243  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     244  Transformation: TTransformation = nil); overload;
     245procedure PolygonFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     246  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     247  Transformation: TTransformation = nil); overload;
     248procedure PolyPolygonFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     249  ClipRect: TRect; Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
     250  Transformation: TTransformation = nil); overload;
     251procedure PolygonFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     252  ClipRect: TRect; Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
     253  Transformation: TTransformation = nil); overload;
     254procedure PolyPolygonFS_LCD(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     255  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     256  Transformation: TTransformation = nil); overload;
     257procedure PolygonFS_LCD(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     258  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     259  Transformation: TTransformation = nil); overload;
     260procedure PolyPolygonFS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     261  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     262  Transformation: TTransformation = nil); overload;
     263procedure PolygonFS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     264  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     265  Transformation: TTransformation = nil); overload;
     266
     267
     268procedure PolyPolylineFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     269  Color: TColor32; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
     270  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     271  MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil); overload;
     272procedure PolyPolylineFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     273  Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
     274  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     275  MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil); overload;
     276
     277procedure PolylineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     278  Color: TColor32; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
     279  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     280  MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil); overload;
     281procedure PolylineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     282  Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
     283  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     284  MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil); overload;
     285
     286//Filled only Dashes ...
     287procedure DashLineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     288  const Dashes: TArrayOfFloat; Color: TColor32;
     289  Closed: Boolean = False; Width: TFloat = 1.0); overload;
     290procedure DashLineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     291  const Dashes: TArrayOfFloat; FillColor, StrokeColor: TColor32;
     292  Closed: Boolean; Width: TFloat; StrokeWidth: TFloat = 2.0); overload;
     293//Filled and stroked Dashes ...
     294procedure DashLineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     295  const Dashes: TArrayOfFloat; Filler: TCustomPolygonFiller;
     296  Closed: Boolean = False; Width: TFloat = 1.0); overload;
     297procedure DashLineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     298  const Dashes: TArrayOfFloat; Filler: TCustomPolygonFiller; StrokeColor: TColor32;
     299  Closed: Boolean; Width: TFloat; StrokeWidth: TFloat = 2.0); overload;
     300
     301procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     302  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     303  Transformation: TTransformation = nil); overload;
     304procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     305  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     306  Transformation: TTransformation = nil); overload;
     307procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     308  Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
     309  Transformation: TTransformation = nil); overload;
     310procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     311  Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
     312  Transformation: TTransformation = nil); overload;
     313procedure PolyPolygonXS_LCD(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     314  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     315  Transformation: TTransformation = nil); overload;
     316procedure PolygonXS_LCD(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     317  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     318  Transformation: TTransformation = nil);
     319procedure PolyPolygonXS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     320  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     321  Transformation: TTransformation = nil); overload;
     322procedure PolygonXS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     323  Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
     324  Transformation: TTransformation = nil);
     325
     326procedure PolyPolylineXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     327  Color: TColor32; Closed: Boolean = False; StrokeWidth: TFixed = $10000;
     328  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     329  MiterLimit: TFixed = $40000; Transformation: TTransformation = nil); overload;
     330procedure PolyPolylineXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     331  Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFixed = $10000;
     332  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     333  MiterLimit: TFixed = $40000; Transformation: TTransformation = nil); overload;
     334
     335procedure PolylineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     336  Color: TColor32; Closed: Boolean = False; StrokeWidth: TFixed = $10000;
     337  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     338  MiterLimit: TFixed = $40000; Transformation: TTransformation = nil); overload;
     339procedure PolylineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     340  Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFixed = $10000;
     341  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     342  MiterLimit: TFixed = $40000; Transformation: TTransformation = nil); overload;
     343
     344//Filled only Dashes ...
     345procedure DashLineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     346  const Dashes: TArrayOfFixed; Color: TColor32;
     347  Closed: Boolean = False; Width: TFixed = $10000); overload;
     348procedure DashLineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     349  const Dashes: TArrayOfFixed; FillColor, StrokeColor: TColor32;
     350  Closed: Boolean; Width: TFixed; StrokeWidth: TFixed = $20000); overload;
     351//Filled and stroked Dashes ...
     352procedure DashLineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     353  const Dashes: TArrayOfFixed; Filler: TCustomPolygonFiller;
     354  Closed: Boolean = False; Width: TFixed = $10000); overload;
     355procedure DashLineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     356  const Dashes: TArrayOfFixed; Filler: TCustomPolygonFiller; StrokeColor: TColor32;
     357  Closed: Boolean; Width: TFixed; StrokeWidth: TFixed = $20000); overload;
     358
     359// fill entire bitmap with a given polygon filler
     360procedure FillBitmap(Bitmap: TBitmap32; Filler: TCustomPolygonFiller);
     361
     362{ Registration routines }
     363procedure RegisterPolygonRenderer(PolygonRendererClass: TCustomPolygonRendererClass);
     364
     365var
     366  PolygonRendererList: TClassList;
     367  DefaultPolygonRendererClass: TPolygonRenderer32Class = TPolygonRenderer32VPR;
     368
    215369implementation
    216370
    217 uses Math;
     371uses
     372  Math, SysUtils, GR32_Math, GR32_LowLevel, GR32_Blend, GR32_Gamma,
     373  GR32_VectorUtils;
     374
     375resourcestring
     376  RCStrNoSamplerSpecified = 'No sampler specified!';
    218377
    219378type
    220   TCustomBitmap32Access = class(TCustomBitmap32);
    221   TShiftFunc = function(Value: Integer): Integer;  // needed for antialiasing to speed things up
    222 // These are for edge scan info. Note, that the most significant bit of the
    223 // edge in a scan line is used for winding (edge direction) info.
    224 
    225   TEdgePoint = Integer;
    226 
    227   PEdgePoints = ^TEdgePoints;
    228   TEdgePoints = array [0..MaxListSize-1] of TEdgePoint;
    229 
    230   PScanLine = ^TScanLine;
    231   TScanLine = record
    232     Count: Integer;
    233     EdgePoints: PEdgePoints;
    234     EdgePointsLength: Integer;
    235   end;
    236 
    237   TScanLines = array of TScanLine;
    238 
    239 const
    240   AA_LINES: Array[TAntialiasMode] of Integer = (32, 16, 8, 4, 2, 1);
    241   AA_SHIFT: Array[TAntialiasMode] of Integer = (5, 4, 3, 2, 1, 0);
    242   AA_MULTI: Array[TAntialiasMode] of Integer = (65, 273, 1167, 5460, 32662, 0);
    243 
    244 { POLYLINES }
    245 
    246 procedure PolylineTS(
    247   Bitmap: TCustomBitmap32;
    248   const Points: TArrayOfFixedPoint;
    249   Color: TColor32;
    250   Closed: Boolean;
     379  TBitmap32Access = class(TBitmap32);
     380
     381procedure RegisterPolygonRenderer(PolygonRendererClass: TCustomPolygonRendererClass);
     382begin
     383  if not Assigned(PolygonRendererList) then PolygonRendererList := TClassList.Create;
     384  PolygonRendererList.Add(PolygonRendererClass);
     385end;
     386
     387// routines for color filling:
     388
     389procedure MakeAlphaNonZeroUP(Coverage: PSingleArray; AlphaValues: PColor32Array;
     390  Count: Integer; Color: TColor32);
     391var
     392  I: Integer;
     393  M, V: Cardinal;
     394  Last: TFloat;
     395  C: TColor32Entry absolute Color;
     396begin
     397  M := C.A * $101;
     398  Last := Infinity;
     399  for I := 0 to Count - 1 do
     400  begin
     401    if PInteger(@Last)^ <> PInteger(@Coverage[I])^ then
     402    begin
     403      Last := Coverage[I];
     404      V := Abs(Round(Last * $10000));
     405      if V > $10000 then V := $10000;
     406      V := V * M shr 24;
     407{$IFDEF USEGR32GAMMA}
     408      V := GAMMA_ENCODING_TABLE[V];
     409{$ENDIF}
     410      C.A := V;
     411    end;
     412    AlphaValues[I] := Color;
     413  end;
     414end;
     415
     416(*
     417procedure MakeAlphaNonZeroUP(Coverage: PSingleArray; AlphaValues: PColor32Array;
     418  Count: Integer; Color: TColor32);
     419var
     420  I: Integer;
     421  M, V, C: Cardinal;
     422begin
     423  M := Color shr 24 * $101;
     424  C := Color and $00ffffff;
     425  for I := 0 to Count - 1 do
     426  begin
     427    V := Abs(Round(Coverage[I] * $10000));
     428    if V > $10000 then V := $10000;
     429{$IFDEF USEGR32GAMMA}
     430    V := GAMMA_ENCODING_TABLE[V * M shr 24];
     431    AlphaValues[I] := (V shl 24) or C;
     432{$ELSE}
     433    AlphaValues[I] := (V * M and $ff000000) or C;
     434{$ENDIF}
     435  end;
     436end;
     437*)
     438
     439procedure MakeAlphaEvenOddUP(Coverage: PSingleArray; AlphaValues: PColor32Array;
     440  Count: Integer; Color: TColor32);
     441var
     442  I: Integer;
     443  M, V: Cardinal;
     444  Last: TFloat;
     445  C: TColor32Entry absolute Color;
     446begin
     447  M := C.A * $101;
     448  Last := Infinity;
     449  for I := 0 to Count - 1 do
     450  begin
     451    if PInteger(@Last)^ <> PInteger(@Coverage[I])^ then
     452    begin
     453      Last := Coverage[I];
     454      V := Abs(Round(Coverage[I] * $10000));
     455      V := V and $01ffff;
     456      if V >= $10000 then
     457        V := V xor $1ffff;
     458      V := V * M shr 24;
     459{$IFDEF USEGR32GAMMA}
     460      V := GAMMA_ENCODING_TABLE[V];
     461{$ENDIF}
     462      C.A := V;
     463    end;
     464    AlphaValues[I] := Color;
     465  end;
     466end;
     467
     468procedure MakeAlphaNonZeroP(Value: Single; AlphaValues: PColor32Array;
     469  Count: Integer; Color: TColor32);
     470var
     471  M, V: Cardinal;
     472  C: TColor32Entry absolute Color;
     473begin
     474  M := C.A * $101;
     475  V := Abs(Round(Value * $10000));
     476  if V > $10000 then V := $10000;
     477  V := V * M shr 24;
     478{$IFDEF USEGR32GAMMA}
     479  V := GAMMA_ENCODING_TABLE[V];
     480{$ENDIF}
     481  C.A := V;
     482  FillLongWord(AlphaValues[0], Count, Color);
     483end;
     484
     485procedure MakeAlphaEvenOddP(Value: Single; AlphaValues: PColor32Array;
     486  Count: Integer; Color: TColor32);
     487var
     488  M, V: Cardinal;
     489  C: TColor32Entry absolute Color;
     490begin
     491  M := C.A * $101;
     492  V := Abs(Round(Value * $10000));
     493  V := V and $01ffff;
     494  if V > $10000 then V := V xor $1ffff;
     495  V := V * M shr 24;
     496{$IFDEF USEGR32GAMMA}
     497  V := GAMMA_ENCODING_TABLE[V];
     498{$ENDIF}
     499  C.A := V;
     500  FillLongWord(AlphaValues[0], Count, Color);
     501end;
     502
     503
     504// polygon filler routines (extract alpha only):
     505
     506procedure MakeAlphaNonZeroUPF(Coverage: PSingleArray; AlphaValues: PColor32Array;
     507  Count: Integer; Color: TColor32);
     508var
     509  I: Integer;
     510  V: Integer;
     511begin
     512  for I := 0 to Count - 1 do
     513  begin
     514    V := Clamp(Round(Abs(Coverage[I]) * 256));
     515{$IFDEF USEGR32GAMMA}
     516    V := GAMMA_ENCODING_TABLE[V];
     517{$ENDIF}
     518    AlphaValues[I] := V;
     519  end;
     520end;
     521
     522procedure MakeAlphaEvenOddUPF(Coverage: PSingleArray; AlphaValues: PColor32Array;
     523  Count: Integer; Color: TColor32);
     524var
     525  I: Integer;
     526  V: Integer;
     527begin
     528  for I := 0 to Count - 1 do
     529  begin
     530    V := Round(Abs(Coverage[I]) * 256);
     531    V := V and $000001ff;
     532    if V >= $100 then V := V xor $1ff;
     533{$IFDEF USEGR32GAMMA}
     534    V := GAMMA_ENCODING_TABLE[V];
     535{$ENDIF}
     536    AlphaValues[I] := V;
     537  end;
     538end;
     539
     540procedure MakeAlphaNonZeroPF(Value: Single; AlphaValues: PColor32Array;
     541  Count: Integer; Color: TColor32);
     542var
     543  V: Integer;
     544begin
     545  V := Clamp(Round(Abs(Value) * 256));
     546{$IFDEF USEGR32GAMMA}
     547    V := GAMMA_ENCODING_TABLE[V];
     548{$ENDIF}
     549  FillLongWord(AlphaValues[0], Count, V);
     550end;
     551
     552procedure MakeAlphaEvenOddPF(Value: Single; AlphaValues: PColor32Array;
     553  Count: Integer; Color: TColor32);
     554var
     555  V: Integer;
     556begin
     557  V := Round(Abs(Value) * 256);
     558  V := V and $000001ff;
     559  if V >= $100 then V := V xor $1ff;
     560{$IFDEF USEGR32GAMMA}
     561    V := GAMMA_ENCODING_TABLE[V];
     562{$ENDIF}
     563  FillLongWord(AlphaValues[0], Count, V);
     564end;
     565
     566procedure PolyPolygonFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     567  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     568var
     569  Renderer: TPolygonRenderer32VPR;
     570begin
     571  Renderer := TPolygonRenderer32VPR.Create;
     572  try
     573    Renderer.Bitmap := Bitmap;
     574    Renderer.Color := Color;
     575    Renderer.FillMode := FillMode;
     576    Renderer.PolyPolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
     577  finally
     578    Renderer.Free;
     579  end;
     580end;
     581
     582procedure PolygonFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     583  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     584var
     585  Renderer: TPolygonRenderer32VPR;
     586begin
     587  Renderer := TPolygonRenderer32VPR.Create;
     588  try
     589    Renderer.Bitmap := Bitmap;
     590    Renderer.Color := Color;
     591    Renderer.FillMode := FillMode;
     592    Renderer.PolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
     593  finally
     594    Renderer.Free;
     595  end;
     596end;
     597
     598procedure PolyPolygonFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     599  Filler: TCustomPolygonFiller; FillMode: TPolyFillMode; Transformation: TTransformation);
     600var
     601  Renderer: TPolygonRenderer32VPR;
     602begin
     603  if not Assigned(Filler) then Exit;
     604  Renderer := TPolygonRenderer32VPR.Create;
     605  try
     606    Renderer.Bitmap := Bitmap;
     607    Renderer.Filler := Filler;
     608    Renderer.FillMode := FillMode;
     609    Renderer.PolyPolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
     610  finally
     611    Renderer.Free;
     612  end;
     613end;
     614
     615procedure PolygonFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     616  Filler: TCustomPolygonFiller; FillMode: TPolyFillMode; Transformation: TTransformation);
     617var
     618  Renderer: TPolygonRenderer32VPR;
     619begin
     620  if not Assigned(Filler) then Exit;
     621  Renderer := TPolygonRenderer32VPR.Create;
     622  try
     623    Renderer.Bitmap := Bitmap;
     624    Renderer.Filler := Filler;
     625    Renderer.FillMode := FillMode;
     626    Renderer.PolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
     627  finally
     628    Renderer.Free;
     629  end;
     630end;
     631
     632procedure PolygonFS_LCD(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     633  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     634var
     635  Renderer: TPolygonRenderer32LCD;
     636begin
     637  Renderer := TPolygonRenderer32LCD.Create;
     638  try
     639    Renderer.Bitmap := Bitmap;
     640    Renderer.FillMode := FillMode;
     641    Renderer.Color := Color;
     642    Renderer.PolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
     643  finally
     644    Renderer.Free;
     645  end;
     646end;
     647
     648procedure PolyPolygonFS_LCD(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     649  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     650var
     651  Renderer: TPolygonRenderer32LCD;
     652begin
     653  Renderer := TPolygonRenderer32LCD.Create;
     654  try
     655    Renderer.Bitmap := Bitmap;
     656    Renderer.FillMode := FillMode;
     657    Renderer.Color := Color;
     658    Renderer.PolyPolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
     659  finally
     660    Renderer.Free;
     661  end;
     662end;
     663
     664procedure PolygonFS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     665  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     666var
     667  Renderer: TPolygonRenderer32LCD2;
     668begin
     669  Renderer := TPolygonRenderer32LCD2.Create;
     670  try
     671    Renderer.Bitmap := Bitmap;
     672    Renderer.FillMode := FillMode;
     673    Renderer.Color := Color;
     674    Renderer.PolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
     675  finally
     676    Renderer.Free;
     677  end;
     678end;
     679
     680procedure PolyPolygonFS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     681  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     682var
     683  Renderer: TPolygonRenderer32LCD2;
     684begin
     685  Renderer := TPolygonRenderer32LCD2.Create;
     686  try
     687    Renderer.Bitmap := Bitmap;
     688    Renderer.FillMode := FillMode;
     689    Renderer.Color := Color;
     690    Renderer.PolyPolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
     691  finally
     692    Renderer.Free;
     693  end;
     694end;
     695
     696procedure PolyPolygonFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     697  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode;
    251698  Transformation: TTransformation);
    252699var
    253   I, Count: Integer;
    254   DoAlpha: Boolean;
    255 begin
    256   Count := Length(Points);
    257 
    258   if (Count = 1) and Closed then
    259     if Assigned(Transformation) then
    260       with Transformation.Transform(Points[0]) do
    261         Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color)
     700  Renderer: TPolygonRenderer32VPR;
     701  IntersectedClipRect: TRect;
     702begin
     703  Renderer := TPolygonRenderer32VPR.Create;
     704  try
     705    Renderer.Bitmap := Bitmap;
     706    Renderer.Color := Color;
     707    Renderer.FillMode := FillMode;
     708    GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
     709    Renderer.PolyPolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
     710  finally
     711    Renderer.Free;
     712  end;
     713end;
     714
     715procedure PolygonFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     716  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode;
     717  Transformation: TTransformation);
     718var
     719  Renderer: TPolygonRenderer32VPR;
     720  IntersectedClipRect: TRect;
     721begin
     722  Renderer := TPolygonRenderer32VPR.Create;
     723  try
     724    Renderer.Bitmap := Bitmap;
     725    Renderer.Color := Color;
     726    Renderer.FillMode := FillMode;
     727    GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
     728    Renderer.PolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
     729  finally
     730    Renderer.Free;
     731  end;
     732end;
     733
     734procedure PolyPolygonFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     735  ClipRect: TRect; Filler: TCustomPolygonFiller; FillMode: TPolyFillMode;
     736  Transformation: TTransformation);
     737var
     738  Renderer: TPolygonRenderer32VPR;
     739  IntersectedClipRect: TRect;
     740begin
     741  if not Assigned(Filler) then Exit;
     742  Renderer := TPolygonRenderer32VPR.Create;
     743  try
     744    Renderer.Bitmap := Bitmap;
     745    Renderer.Filler := Filler;
     746    Renderer.FillMode := FillMode;
     747    GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
     748    Renderer.PolyPolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
     749  finally
     750    Renderer.Free;
     751  end;
     752end;
     753
     754procedure PolygonFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     755  ClipRect: TRect; Filler: TCustomPolygonFiller; FillMode: TPolyFillMode;
     756  Transformation: TTransformation);
     757var
     758  Renderer: TPolygonRenderer32VPR;
     759  IntersectedClipRect: TRect;
     760begin
     761  if not Assigned(Filler) then Exit;
     762  Renderer := TPolygonRenderer32VPR.Create;
     763  try
     764    Renderer.Bitmap := Bitmap;
     765    Renderer.Filler := Filler;
     766    Renderer.FillMode := FillMode;
     767    GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
     768    Renderer.PolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
     769  finally
     770    Renderer.Free;
     771  end;
     772end;
     773
     774procedure PolygonFS_LCD(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     775  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode;
     776  Transformation: TTransformation);
     777var
     778  Renderer: TPolygonRenderer32LCD;
     779  IntersectedClipRect: TRect;
     780begin
     781  Renderer := TPolygonRenderer32LCD.Create;
     782  try
     783    Renderer.Bitmap := Bitmap;
     784    Renderer.FillMode := FillMode;
     785    Renderer.Color := Color;
     786    GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
     787    Renderer.PolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
     788  finally
     789    Renderer.Free;
     790  end;
     791end;
     792
     793procedure PolyPolygonFS_LCD(Bitmap: TBitmap32;
     794  const Points: TArrayOfArrayOfFloatPoint; ClipRect: TRect; Color: TColor32;
     795  FillMode: TPolyFillMode; Transformation: TTransformation);
     796var
     797  Renderer: TPolygonRenderer32LCD;
     798  IntersectedClipRect: TRect;
     799begin
     800  Renderer := TPolygonRenderer32LCD.Create;
     801  try
     802    Renderer.Bitmap := Bitmap;
     803    Renderer.FillMode := FillMode;
     804    Renderer.Color := Color;
     805    GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
     806    Renderer.PolyPolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
     807  finally
     808    Renderer.Free;
     809  end;
     810end;
     811
     812procedure PolygonFS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     813  ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode;
     814  Transformation: TTransformation);
     815var
     816  Renderer: TPolygonRenderer32LCD2;
     817  IntersectedClipRect: TRect;
     818begin
     819  Renderer := TPolygonRenderer32LCD2.Create;
     820  try
     821    Renderer.Bitmap := Bitmap;
     822    Renderer.FillMode := FillMode;
     823    Renderer.Color := Color;
     824    GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
     825    Renderer.PolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
     826  finally
     827    Renderer.Free;
     828  end;
     829end;
     830
     831procedure PolyPolygonFS_LCD2(Bitmap: TBitmap32;
     832  const Points: TArrayOfArrayOfFloatPoint; ClipRect: TRect; Color: TColor32;
     833  FillMode: TPolyFillMode; Transformation: TTransformation);
     834var
     835  Renderer: TPolygonRenderer32LCD2;
     836  IntersectedClipRect: TRect;
     837begin
     838  Renderer := TPolygonRenderer32LCD2.Create;
     839  try
     840    Renderer.Bitmap := Bitmap;
     841    Renderer.FillMode := FillMode;
     842    Renderer.Color := Color;
     843    GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
     844    Renderer.PolyPolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
     845  finally
     846    Renderer.Free;
     847  end;
     848end;
     849
     850procedure PolyPolylineFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     851  Color: TColor32; Closed: Boolean; StrokeWidth: TFloat;
     852  JoinStyle: TJoinStyle; EndStyle: TEndStyle;
     853  MiterLimit: TFloat; Transformation: TTransformation);
     854var
     855  Dst: TArrayOfArrayOfFloatPoint;
     856begin
     857  Dst := BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle, MiterLimit);
     858  PolyPolygonFS(Bitmap, Dst, Color, pfWinding, Transformation);
     859end;
     860
     861procedure PolyPolylineFS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
     862  Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
     863  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     864  MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil);
     865var
     866  Dst: TArrayOfArrayOfFloatPoint;
     867begin
     868  Dst := BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle, MiterLimit);
     869  PolyPolygonFS(Bitmap, Dst, Filler, pfWinding, Transformation);
     870end;
     871
     872procedure PolylineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     873  Color: TColor32; Closed: Boolean; StrokeWidth: TFloat;
     874  JoinStyle: TJoinStyle; EndStyle: TEndStyle;
     875  MiterLimit: TFloat; Transformation: TTransformation);
     876begin
     877  PolyPolylineFS(Bitmap, PolyPolygon(Points), Color, Closed, StrokeWidth,
     878    JoinStyle, EndStyle, MiterLimit, Transformation);
     879end;
     880
     881procedure PolylineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     882  Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
     883  JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
     884  MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil);
     885begin
     886  PolyPolylineFS(Bitmap, PolyPolygon(Points), Filler, Closed, StrokeWidth,
     887    JoinStyle, EndStyle, MiterLimit, Transformation);
     888end;
     889
     890procedure DashLineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     891  const Dashes: TArrayOfFloat; Color: TColor32;
     892  Closed: Boolean = False; Width: TFloat = 1.0);
     893var
     894  MultiPoly: TArrayOfArrayOfFloatPoint;
     895begin
     896  MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
     897  PolyPolylineFS(Bitmap, MultiPoly, Color, False, Width);
     898end;
     899
     900procedure DashLineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     901  const Dashes: TArrayOfFloat; FillColor, StrokeColor: TColor32;
     902  Closed: Boolean; Width: TFloat; StrokeWidth: TFloat = 2.0);
     903var
     904  MultiPoly: TArrayOfArrayOfFloatPoint;
     905begin
     906  MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
     907  MultiPoly := BuildPolyPolyLine(MultiPoly, False, Width);
     908  PolyPolygonFS(Bitmap, MultiPoly, FillColor);
     909  PolyPolylineFS(Bitmap, MultiPoly, StrokeColor, True, StrokeWidth);
     910end;
     911
     912procedure DashLineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     913  const Dashes: TArrayOfFloat; Filler: TCustomPolygonFiller;
     914  Closed: Boolean = False; Width: TFloat = 1.0);
     915var
     916  MultiPoly: TArrayOfArrayOfFloatPoint;
     917begin
     918  MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
     919  PolyPolylineFS(Bitmap, MultiPoly, Filler, False, Width);
     920end;
     921
     922procedure DashLineFS(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
     923  const Dashes: TArrayOfFloat; Filler: TCustomPolygonFiller; StrokeColor: TColor32;
     924  Closed: Boolean; Width: TFloat; StrokeWidth: TFloat = 2.0);
     925var
     926  MultiPoly: TArrayOfArrayOfFloatPoint;
     927begin
     928  MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
     929  MultiPoly := BuildPolyPolyLine(MultiPoly, False, Width);
     930  PolyPolygonFS(Bitmap, MultiPoly, Filler);
     931  PolyPolylineFS(Bitmap, MultiPoly, StrokeColor, True, StrokeWidth);
     932end;
     933
     934
     935procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     936  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     937var
     938  Renderer: TPolygonRenderer32VPR;
     939begin
     940  Renderer := TPolygonRenderer32VPR.Create;
     941  try
     942    Renderer.Bitmap := Bitmap;
     943    Renderer.Color := Color;
     944    Renderer.FillMode := FillMode;
     945    Renderer.PolyPolygonFS(FixedPointToFloatPoint(Points),
     946      FloatRect(Bitmap.ClipRect), Transformation);
     947  finally
     948    Renderer.Free;
     949  end;
     950end;
     951
     952procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     953  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     954var
     955  Renderer: TPolygonRenderer32VPR;
     956begin
     957  Renderer := TPolygonRenderer32VPR.Create;
     958  try
     959    Renderer.Bitmap := Bitmap;
     960    Renderer.Color := Color;
     961    Renderer.FillMode := FillMode;
     962    Renderer.PolygonFS(FixedPointToFloatPoint(Points),
     963      FloatRect(Bitmap.ClipRect), Transformation);
     964  finally
     965    Renderer.Free;
     966  end;
     967end;
     968
     969procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     970  Filler: TCustomPolygonFiller; FillMode: TPolyFillMode; Transformation: TTransformation);
     971var
     972  Renderer: TPolygonRenderer32VPR;
     973begin
     974  Renderer := TPolygonRenderer32VPR.Create;
     975  try
     976    Renderer.Bitmap := Bitmap;
     977    Renderer.Filler := Filler;
     978    Renderer.FillMode := FillMode;
     979    Renderer.PolyPolygonFS(FixedPointToFloatPoint(Points),
     980      FloatRect(Bitmap.ClipRect), Transformation);
     981  finally
     982    Renderer.Free;
     983  end;
     984end;
     985
     986procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     987  Filler: TCustomPolygonFiller; FillMode: TPolyFillMode; Transformation: TTransformation);
     988var
     989  Renderer: TPolygonRenderer32VPR;
     990begin
     991  Renderer := TPolygonRenderer32VPR.Create;
     992  try
     993    Renderer.Bitmap := Bitmap;
     994    Renderer.Filler := Filler;
     995    Renderer.FillMode := FillMode;
     996    Renderer.PolygonFS(FixedPointToFloatPoint(Points),
     997      FloatRect(Bitmap.ClipRect), Transformation);
     998  finally
     999    Renderer.Free;
     1000  end;
     1001end;
     1002
     1003procedure PolygonXS_LCD(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     1004  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     1005var
     1006  Renderer: TPolygonRenderer32LCD;
     1007begin
     1008  Renderer := TPolygonRenderer32LCD.Create;
     1009  try
     1010    Renderer.Bitmap := Bitmap;
     1011    Renderer.FillMode := FillMode;
     1012    Renderer.Color := Color;
     1013    Renderer.PolygonFS(FixedPointToFloatPoint(Points),
     1014      FloatRect(Bitmap.ClipRect), Transformation);
     1015  finally
     1016    Renderer.Free;
     1017  end;
     1018end;
     1019
     1020procedure PolyPolygonXS_LCD(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     1021  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     1022var
     1023  Renderer: TPolygonRenderer32LCD;
     1024begin
     1025  Renderer := TPolygonRenderer32LCD.Create;
     1026  try
     1027    Renderer.Bitmap := Bitmap;
     1028    Renderer.FillMode := FillMode;
     1029    Renderer.Color := Color;
     1030    Renderer.PolyPolygonFS(FixedPointToFloatPoint(Points),
     1031      FloatRect(Bitmap.ClipRect), Transformation);
     1032  finally
     1033    Renderer.Free;
     1034  end;
     1035end;
     1036
     1037procedure PolygonXS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     1038  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     1039var
     1040  Renderer: TPolygonRenderer32LCD2;
     1041begin
     1042  Renderer := TPolygonRenderer32LCD2.Create;
     1043  try
     1044    Renderer.Bitmap := Bitmap;
     1045    Renderer.FillMode := FillMode;
     1046    Renderer.Color := Color;
     1047    Renderer.PolygonFS(FixedPointToFloatPoint(Points),
     1048      FloatRect(Bitmap.ClipRect), Transformation);
     1049  finally
     1050    Renderer.Free;
     1051  end;
     1052end;
     1053
     1054procedure PolyPolygonXS_LCD2(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     1055  Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
     1056var
     1057  Renderer: TPolygonRenderer32LCD2;
     1058begin
     1059  Renderer := TPolygonRenderer32LCD2.Create;
     1060  try
     1061    Renderer.Bitmap := Bitmap;
     1062    Renderer.FillMode := FillMode;
     1063    Renderer.Color := Color;
     1064    Renderer.PolyPolygonFS(FixedPointToFloatPoint(Points),
     1065      FloatRect(Bitmap.ClipRect), Transformation);
     1066  finally
     1067    Renderer.Free;
     1068  end;
     1069end;
     1070
     1071procedure PolyPolylineXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     1072  Color: TColor32; Closed: Boolean; StrokeWidth: TFixed;
     1073  JoinStyle: TJoinStyle; EndStyle: TEndStyle;
     1074  MiterLimit: TFixed; Transformation: TTransformation);
     1075var
     1076  Dst: TArrayOfArrayOfFixedPoint;
     1077begin
     1078  Dst := BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle,
     1079    MiterLimit);
     1080  PolyPolygonXS(Bitmap, Dst, Color, pfWinding, Transformation);
     1081end;
     1082
     1083procedure PolyPolylineXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
     1084  Filler: TCustomPolygonFiller; Closed: Boolean = False;
     1085  StrokeWidth: TFixed = $10000; JoinStyle: TJoinStyle = jsMiter;
     1086  EndStyle: TEndStyle = esButt; MiterLimit: TFixed = $40000;
     1087  Transformation: TTransformation = nil);
     1088var
     1089  Dst: TArrayOfArrayOfFixedPoint;
     1090begin
     1091  Dst := BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle,
     1092    MiterLimit);
     1093  PolyPolygonXS(Bitmap, Dst, Filler, pfWinding, Transformation);
     1094end;
     1095
     1096procedure PolylineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     1097  Color: TColor32; Closed: Boolean; StrokeWidth: TFixed;
     1098  JoinStyle: TJoinStyle; EndStyle: TEndStyle;
     1099  MiterLimit: TFixed; Transformation: TTransformation);
     1100begin
     1101  PolyPolylineXS(Bitmap, PolyPolygon(Points), Color,
     1102    Closed, StrokeWidth, JoinStyle, EndStyle,
     1103    MiterLimit, Transformation);
     1104end;
     1105
     1106procedure PolylineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     1107  Filler: TCustomPolygonFiller; Closed: Boolean = False;
     1108  StrokeWidth: TFixed = $10000; JoinStyle: TJoinStyle = jsMiter;
     1109  EndStyle: TEndStyle = esButt; MiterLimit: TFixed = $40000;
     1110  Transformation: TTransformation = nil);
     1111begin
     1112  PolyPolylineXS(Bitmap, PolyPolygon(Points), Filler, Closed, StrokeWidth,
     1113    JoinStyle, EndStyle, MiterLimit, Transformation);
     1114end;
     1115
     1116procedure DashLineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     1117  const Dashes: TArrayOfFixed; Color: TColor32;
     1118  Closed: Boolean = False; Width: TFixed = $10000);
     1119var
     1120  MultiPoly: TArrayOfArrayOfFixedPoint;
     1121begin
     1122  MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
     1123  PolyPolylineXS(Bitmap, MultiPoly, Color, False, Width);
     1124end;
     1125
     1126procedure DashLineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     1127  const Dashes: TArrayOfFixed; FillColor, StrokeColor: TColor32;
     1128  Closed: Boolean; Width: TFixed; StrokeWidth: TFixed = $20000);
     1129var
     1130  MultiPoly: TArrayOfArrayOfFixedPoint;
     1131begin
     1132  MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
     1133  PolyPolylineXS(Bitmap, MultiPoly, FillColor, False, Width);
     1134  MultiPoly := BuildPolyPolyLine(MultiPoly, False, Width);
     1135  PolyPolylineXS(Bitmap, MultiPoly, StrokeColor, True, strokeWidth);
     1136end;
     1137
     1138procedure DashLineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     1139  const Dashes: TArrayOfFixed; Filler: TCustomPolygonFiller;
     1140  Closed: Boolean = False; Width: TFixed = $10000);
     1141var
     1142  MultiPoly: TArrayOfArrayOfFixedPoint;
     1143begin
     1144  MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
     1145  PolyPolylineXS(Bitmap, MultiPoly, Filler, False, Width);
     1146end;
     1147
     1148procedure DashLineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
     1149  const Dashes: TArrayOfFixed; Filler: TCustomPolygonFiller; StrokeColor: TColor32;
     1150  Closed: Boolean; Width: TFixed; StrokeWidth: TFixed = $20000);
     1151var
     1152  MultiPoly: TArrayOfArrayOfFixedPoint;
     1153begin
     1154  MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
     1155  PolyPolylineXS(Bitmap, MultiPoly, Filler, False, Width);
     1156  MultiPoly := BuildPolyPolyLine(MultiPoly, False, Width);
     1157  PolyPolylineXS(Bitmap, MultiPoly, StrokeColor, True, StrokeWidth);
     1158end;
     1159
     1160procedure FillBitmap(Bitmap: TBitmap32; Filler: TCustomPolygonFiller);
     1161var
     1162  AlphaValues: PColor32;
     1163  Y: Integer;
     1164begin
     1165  {$IFDEF USESTACKALLOC}
     1166  AlphaValues := StackAlloc(Bitmap.Width * SizeOf(TColor32));
     1167  {$ELSE}
     1168  GetMem(AlphaValues, Bitmap.Width * SizeOf(TColor32));
     1169  {$ENDIF}
     1170  FillLongword(AlphaValues^, Bitmap.Width, $FF);
     1171  Filler.BeginRendering;
     1172  for Y := 0 to Bitmap.Height - 1 do
     1173    Filler.FillLine(PColor32(Bitmap.ScanLine[y]), 0, y, Bitmap.Width,
     1174      AlphaValues, Bitmap.CombineMode);
     1175  Filler.EndRendering;
     1176  {$IFDEF USESTACKALLOC}
     1177  StackFree(AlphaValues);
     1178  {$ELSE}
     1179  FreeMem(AlphaValues);
     1180  {$ENDIF}
     1181end;
     1182
     1183
     1184{ LCD sub-pixel rendering (see http://www.grc.com/cttech.htm) }
     1185
     1186type
     1187  PRGBTriple = ^TRGBTriple;
     1188  TRGBTriple = packed record
     1189    B, G, R: Byte;
     1190  end;
     1191
     1192  PRGBTripleArray = ^TRGBTripleArray;
     1193  TRGBTripleArray = array [0..0] of TRGBTriple;
     1194
     1195  TMakeAlphaProcLCD = procedure(Coverage: PSingleArray; AlphaValues: SysUtils.PByteArray;
     1196    Count: Integer; Color: TColor32);
     1197
     1198procedure MakeAlphaNonZeroLCD(Coverage: PSingleArray; AlphaValues: SysUtils.PByteArray;
     1199  Count: Integer; Color: TColor32);
     1200var
     1201  I: Integer;
     1202  M, V: Cardinal;
     1203  Last: TFloat;
     1204  C: TColor32Entry absolute Color;
     1205begin
     1206  M := C.A * 86;  // 86 = 258 / 3
     1207
     1208  Last := Infinity;
     1209  V := 0;
     1210  AlphaValues[0] := 0;
     1211  AlphaValues[1] := 0;
     1212  for I := 0 to Count - 1 do
     1213  begin
     1214    if PInteger(@Last)^ <> PInteger(@Coverage[I])^ then
     1215    begin
     1216      Last := Coverage[I];
     1217      V := Abs(Round(Last * $10000));
     1218      if V > $10000 then V := $10000;
     1219      V := V * M shr 24;
     1220    end;
     1221    Inc(AlphaValues[I], V);
     1222{$IFDEF USEGR32GAMMA}
     1223    AlphaValues[I] := GAMMA_ENCODING_TABLE[AlphaValues[I]];
     1224{$ENDIF}
     1225    Inc(AlphaValues[I + 1], V);
     1226    AlphaValues[I + 2] := V;
     1227  end;
     1228  AlphaValues[Count + 2] := 0;
     1229  AlphaValues[Count + 3] := 0;
     1230end;
     1231
     1232procedure MakeAlphaEvenOddLCD(Coverage: PSingleArray; AlphaValues: SysUtils.PByteArray;
     1233  Count: Integer; Color: TColor32);
     1234var
     1235  I: Integer;
     1236  M, V: Cardinal;
     1237  Last: TFloat;
     1238begin
     1239  M := Color shr 24 * 86;  // 86 = 258 / 3
     1240
     1241  Last := Infinity;
     1242  V := 0;
     1243  AlphaValues[0] := 0;
     1244  AlphaValues[1] := 0;
     1245  for I := 0 to Count - 1 do
     1246  begin
     1247    if PInteger(@Last)^ <> PInteger(@Coverage[I])^ then
     1248    begin
     1249      Last := Coverage[I];
     1250      V := Abs(Round(Coverage[I] * $10000));
     1251      V := V and $01ffff;
     1252      if V >= $10000 then V := V xor $1ffff;
     1253      V := V * M shr 24;
     1254    end;
     1255    Inc(AlphaValues[I], V);
     1256{$IFDEF USEGR32GAMMA}
     1257    AlphaValues[I] := GAMMA_ENCODING_TABLE[AlphaValues[I]];
     1258{$ENDIF}
     1259    Inc(AlphaValues[I + 1], V);
     1260    AlphaValues[I + 2] := V;
     1261  end;
     1262  AlphaValues[Count + 2] := 0;
     1263  AlphaValues[Count + 3] := 0;
     1264end;
     1265
     1266procedure MakeAlphaNonZeroLCD2(Coverage: PSingleArray; AlphaValues: SysUtils.PByteArray;
     1267  Count: Integer; Color: TColor32);
     1268var
     1269  I: Integer;
     1270begin
     1271  MakeAlphaNonZeroLCD(Coverage, AlphaValues, Count, Color);
     1272  AlphaValues[Count + 2] := (AlphaValues[Count] + AlphaValues[Count + 1]) div 3;
     1273  AlphaValues[Count + 3] := AlphaValues[Count + 1] div 3;
     1274  for I := Count + 1 downto 2 do
     1275  begin
     1276    AlphaValues[I] := (AlphaValues[I] + AlphaValues[I - 1] + AlphaValues[I - 2]) div 3;
     1277  end;
     1278  AlphaValues[1] := (AlphaValues[0] + AlphaValues[1]) div 3;
     1279  AlphaValues[0] := AlphaValues[0] div 3;
     1280end;
     1281
     1282procedure MakeAlphaEvenOddLCD2(Coverage: PSingleArray; AlphaValues: SysUtils.PByteArray;
     1283  Count: Integer; Color: TColor32);
     1284var
     1285  I: Integer;
     1286begin
     1287  MakeAlphaEvenOddLCD(Coverage, AlphaValues, Count, Color);
     1288  AlphaValues[Count + 2] := (AlphaValues[Count] + AlphaValues[Count + 1]) div 3;
     1289  AlphaValues[Count + 3] := AlphaValues[Count + 1] div 3;
     1290  for I := Count + 1 downto 2 do
     1291  begin
     1292    AlphaValues[I] := (AlphaValues[I] + AlphaValues[I - 1] + AlphaValues[I - 2]) div 3;
     1293  end;
     1294  AlphaValues[1] := (AlphaValues[0] + AlphaValues[1]) div 3;
     1295  AlphaValues[0] := AlphaValues[0] div 3;
     1296end;
     1297
     1298procedure CombineLineLCD(Weights: PRGBTripleArray; Dst: PColor32Array; Color: TColor32; Count: Integer);
     1299var
     1300  I: Integer;
     1301  {$IFDEF TEST_BLENDMEMRGB128SSE4}
     1302  Weights64: UInt64;
     1303  {$ENDIF}
     1304begin
     1305  I := 0;
     1306  while Count <> 0 do
     1307    {$IFDEF TEST_BLENDMEMRGB128SSE4}
     1308    if (Count shr 1) = 0 then
     1309    {$ENDIF}
     1310    begin
     1311      if PColor32(@Weights[I])^ = $FFFFFFFF then
     1312        Dst[I] := Color
     1313      else
     1314        BlendMemRGB(Color, Dst[I], PColor32(@Weights[I])^);
     1315      Dec(Count);
     1316      Inc(I);
     1317    end
     1318    {$IFDEF TEST_BLENDMEMRGB128SSE4}
    2621319    else
    263       with Points[0] do
    264         Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color);
    265 
    266   if Count < 2 then Exit;
    267   DoAlpha := Color and $FF000000 <> $FF000000;
    268   Bitmap.BeginUpdate;
    269   Bitmap.PenColor := Color;
    270 
    271   if Assigned(Transformation) then
    272   begin
    273     with Transformation.Transform(Points[0]) do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
    274     if DoAlpha then
    275       for I := 1 to Count - 1 do
    276         with Transformation.Transform(Points[I]) do
    277           Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
    278     else
    279       for I := 1 to Count - 1 do
    280         with Transformation.Transform(Points[I]) do
    281           Bitmap.LineToS(FixedRound(X), FixedRound(Y));
    282 
    283     if Closed then with Transformation.Transform(Points[0]) do
    284       if DoAlpha then
    285         Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
    286       else
    287         Bitmap.LineToS(FixedRound(X), FixedRound(Y));
    288   end
    289   else
    290   begin
    291     with Points[0] do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
    292     if DoAlpha then
    293       for I := 1 to Count - 1 do
    294         with Points[I] do
    295           Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
    296     else
    297       for I := 1 to Count - 1 do
    298         with Points[I] do
    299           Bitmap.LineToS(FixedRound(X), FixedRound(Y));
    300 
    301     if Closed then with Points[0] do
    302       if DoAlpha then
    303         Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
    304       else
    305         Bitmap.LineToS(FixedRound(X), FixedRound(Y));
    306   end;
    307 
    308   Bitmap.EndUpdate;
    309   Bitmap.Changed;
    310 end;
    311 
    312 procedure PolylineAS(
    313   Bitmap: TCustomBitmap32;
    314   const Points: TArrayOfFixedPoint;
    315   Color: TColor32;
    316   Closed: Boolean;
    317   Transformation: TTransformation);
    318 var
    319   I, Count: Integer;
    320 begin
    321   Count := Length(Points);
    322   if (Count = 1) and Closed then
    323     if Assigned(Transformation) then
    324       with Transformation.Transform(Points[0]) do
    325         Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color)
    326     else
    327       with Points[0] do
    328         Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color);
    329 
    330   if Count < 2 then Exit;
    331   Bitmap.BeginUpdate;
    332   Bitmap.PenColor := Color;
    333 
    334   if Assigned(Transformation) then
    335   begin
    336     with Transformation.Transform(Points[0]) do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
    337     for I := 1 to Count - 1 do
    338       with Transformation.Transform(Points[I]) do
    339         Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
    340     if Closed then with Transformation.Transform(Points[0]) do Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
    341   end
    342   else
    343   begin
    344     with Points[0] do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
    345     for I := 1 to Count - 1 do
    346       with Points[I] do
    347         Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
    348     if Closed then with Points[0] do Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
    349   end;
    350 
    351   Bitmap.EndUpdate;
    352   Bitmap.Changed;
    353 end;
    354 
    355 procedure PolylineXS(
    356   Bitmap: TCustomBitmap32;
    357   const Points: TArrayOfFixedPoint;
    358   Color: TColor32;
    359   Closed: Boolean;
    360   Transformation: TTransformation);
    361 var
    362   I, Count: Integer;
    363 begin
    364   Count := Length(Points);
    365   if (Count = 1) and Closed then
    366     if Assigned(Transformation) then
    367       with Transformation.Transform(Points[0]) do Bitmap.PixelXS[X, Y] := Color
    368     else
    369       with Points[0] do Bitmap.PixelXS[X, Y] := Color;
    370 
    371   if Count < 2 then Exit;
    372   Bitmap.BeginUpdate;
    373   Bitmap.PenColor := Color;
    374 
    375   if Assigned(Transformation) then
    376   begin
    377     with Transformation.Transform(Points[0]) do Bitmap.MoveToX(X, Y);
    378     for I := 1 to Count - 1 do with Transformation.Transform(Points[I]) do Bitmap.LineToXS(X, Y);
    379     if Closed then with Transformation.Transform(Points[0]) do Bitmap.LineToXS(X, Y);
    380   end
    381   else
    382   begin
    383     with Points[0] do Bitmap.MoveToX(X, Y);
    384     for I := 1 to Count - 1 do with Points[I] do Bitmap.LineToXS(X, Y);
    385     if Closed then with Points[0] do Bitmap.LineToXS(X, Y);
    386   end;
    387 
    388   Bitmap.EndUpdate;
    389   Bitmap.Changed;
    390 end;
    391 
    392 procedure PolylineXSP(
    393   Bitmap: TCustomBitmap32;
    394   const Points: TArrayOfFixedPoint;
    395   Closed: Boolean;
    396   Transformation: TTransformation);
    397 var
    398   I, Count: Integer;
    399 begin
    400   Count := Length(Points);
    401   if Count < 2 then Exit;
    402   Bitmap.BeginUpdate;
    403   if Assigned(Transformation) then
    404   begin
    405     with Transformation.Transform(Points[0]) do Bitmap.MoveToX(X, Y);
    406     for I := 1 to Count - 1 do with Transformation.Transform(Points[I]) do Bitmap.LineToXSP(X, Y);
    407     if Closed then with Transformation.Transform(Points[0]) do Bitmap.LineToXSP(X, Y);
    408   end
    409   else
    410   begin
    411     with Points[0] do Bitmap.MoveToX(X, Y);
    412     for I := 1 to Count - 1 do with Points[I] do Bitmap.LineToXSP(X, Y);
    413     if Closed then with Points[0] do Bitmap.LineToXSP(X, Y);
    414   end;
    415 
    416   Bitmap.EndUpdate;
    417   Bitmap.Changed;
    418 end;
    419 
    420 procedure PolyPolylineTS(
    421   Bitmap: TCustomBitmap32;
    422   const Points: TArrayOfArrayOfFixedPoint;
    423   Color: TColor32;
    424   Closed: Boolean;
    425   Transformation: TTransformation);
    426 var
    427   I: Integer;
    428 begin
    429   for I := 0 to High(Points) do PolylineTS(Bitmap, Points[I], Color, Closed, Transformation);
    430 end;
    431 
    432 procedure PolyPolylineAS(
    433   Bitmap: TCustomBitmap32;
    434   const Points: TArrayOfArrayOfFixedPoint;
    435   Color: TColor32;
    436   Closed: Boolean;
    437   Transformation: TTransformation);
    438 var
    439   I: Integer;
    440 begin
    441   for I := 0 to High(Points) do PolylineAS(Bitmap, Points[I], Color, Closed, Transformation);
    442 end;
    443 
    444 procedure PolyPolylineXS(
    445   Bitmap: TCustomBitmap32;
    446   const Points: TArrayOfArrayOfFixedPoint;
    447   Color: TColor32;
    448   Closed: Boolean;
    449   Transformation: TTransformation);
    450 var
    451   I: Integer;
    452 begin
    453   for I := 0 to High(Points) do PolylineXS(Bitmap, Points[I], Color, Closed, Transformation);
    454 end;
    455 
    456 procedure PolyPolylineXSP(
    457   Bitmap: TCustomBitmap32;
    458   const Points: TArrayOfArrayOfFixedPoint;
    459   Closed: Boolean;
    460   Transformation: TTransformation);
    461 var
    462   I: Integer;
    463 begin
    464   for I := 0 to High(Points) do PolylineXSP(Bitmap, Points[I], Closed, Transformation);
    465 end;
    466 
    467 
    468 { General routines for drawing polygons }
    469 
    470 procedure ScanLinesCreate(var ScanLines: TScanLines; Length: Integer);
    471 begin
    472   SetLength(ScanLines, Length);
    473 end;
    474 
    475 procedure ScanLinesDestroy(var ScanLines: TScanLines);
    476 var
    477   I: Integer;
    478 begin
    479   for I := 0 to High(ScanLines) do
    480     FreeMem(ScanLines[I].EdgePoints);
    481 
    482   SetLength(ScanLines, 0);
    483 end;
    484 
    485 
    486 { Routines for sorting edge points in scanlines }
    487 
    488 const
    489   SortThreshold = 10;
    490   ReallocationThreshold = 64;
    491 
    492 procedure InsertionSort(LPtr, RPtr: PInteger);
    493 var
    494   IPtr, JPtr: PInteger;
    495   Temp: PInteger;
    496   P, C, T: Integer;
    497 begin
    498   IPtr := LPtr;
    499   Inc(IPtr);
    500   repeat
    501     C := IPtr^;
    502     P := C and $7FFFFFFF;
    503     JPtr := IPtr;
    504 
    505 {$IFDEF HAS_NATIVEINT}
    506     if NativeUInt(JPtr) > NativeUInt(LPtr) then
    507 {$ELSE}
    508     if Cardinal(JPtr) > Cardinal(LPtr) then
    509 {$ENDIF}
    510     repeat
    511       Temp := JPtr;
    512       Dec(Temp);
    513       T := Temp^;
    514       if T and $7FFFFFFF > P then
     1320    begin
     1321      Weights64 := (UInt64(PColor32(@Weights[I + 1])^) shl 32) or
     1322        PColor32(@Weights[I])^;
     1323      if Weights64 = $FFFFFFFFFFFFFFFF then
    5151324      begin
    516         JPtr^ := T;
    517         JPtr := Temp;
     1325        Dst[I] := Color;
     1326        Dst[I + 1] := Color;
    5181327      end
    5191328      else
    520         Break;
    521 {$IFDEF HAS_NATIVEINT}
    522     until NativeUInt(JPtr) <= NativeUInt(LPtr);
    523 {$ELSE}
    524     until Cardinal(JPtr) <= Cardinal(LPtr);
    525 {$ENDIF}
    526 
    527     JPtr^ := C;
    528     Inc(IPtr);
    529 {$IFDEF HAS_NATIVEINT}
    530   until NativeUInt(IPtr) > NativeUInt(RPtr);
    531 {$ELSE}
    532   until Cardinal(IPtr) > Cardinal(RPtr);
    533 {$ENDIF}
    534 end;
    535 
    536 procedure QuickSort(LPtr, RPtr: PInteger);
    537 var
    538 {$IFDEF HAS_NATIVEINT}
    539   P: NativeUInt;
    540 {$ELSE}
    541   P: Cardinal;
    542 {$ENDIF}
    543   TempVal: Integer;
    544   IPtr, JPtr: PInteger;
    545   Temp: Integer;
    546 const
    547   OddMask = SizeOf(Integer) and not(SizeOf(Integer) - 1);
    548 begin
    549   {$IFDEF HAS_NATIVEINT}
    550   if NativeUInt(RPtr) - NativeUInt(LPtr) > SortThreshold shl 2 then
    551   {$ELSE}
    552   if Cardinal(RPtr) - Cardinal(LPtr) > SortThreshold shl 2 then
    553   {$ENDIF}
    554   repeat
    555     {$IFDEF HAS_NATIVEINT}
    556     P := NativeUInt(RPtr) - NativeUInt(LPtr);
    557     if (P and OddMask > 0) then Dec(P, SizeOf(Integer));
    558     TempVal := PInteger(NativeUInt(LPtr) + P shr 1)^ and $7FFFFFFF;
    559     {$ELSE}
    560     P := Cardinal(RPtr) - Cardinal(LPtr);
    561     if (P and OddMask > 0) then Dec(P, SizeOf(Integer));
    562     TempVal := PInteger(Cardinal(LPtr) + P shr 1)^ and $7FFFFFFF;
    563     {$ENDIF}
    564 
    565     IPtr := LPtr;
    566     JPtr := RPtr;
    567     repeat
    568       while (IPtr^ and $7FFFFFFF) < TempVal do Inc(IPtr);
    569       while (JPtr^ and $7FFFFFFF) > TempVal do Dec(JPtr);
    570       {$IFDEF HAS_NATIVEINT}
    571       if NativeUInt(IPtr) <= NativeUInt(JPtr) then
    572       {$ELSE}
    573       if Cardinal(IPtr) <= Cardinal(JPtr) then
    574       {$ENDIF}
    575       begin
    576         Temp := IPtr^;
    577         IPtr^ := JPtr^;
    578         JPtr^ := Temp;
    579 //        Swap(IPtr^, JPtr^);
    580         Inc(IPtr);
    581         Dec(JPtr);
    582       end;
    583     {$IFDEF HAS_NATIVEINT}
    584     until NativeUInt(IPtr) > NativeUInt(JPtr);
    585     if NativeUInt(LPtr) < NativeUInt(JPtr) then
    586     {$ELSE}
    587     until Integer(IPtr) > Integer(JPtr);
    588     if Cardinal(LPtr) < Cardinal(JPtr) then
    589     {$ENDIF}
    590       QuickSort(LPtr, JPtr);
    591     LPtr := IPtr;
    592   {$IFDEF HAS_NATIVEINT}
    593   until NativeUInt(IPtr) >= NativeUInt(RPtr)
    594   {$ELSE}
    595   until Cardinal(IPtr) >= Cardinal(RPtr)
    596   {$ENDIF}
    597   else
    598     InsertionSort(LPtr, RPtr);
    599 end;
    600 
    601 procedure SortLine(const ALine: TScanLine);
    602 var
    603   L, T: Integer;
    604 begin
    605   L := ALine.Count;
    606   Assert(not Odd(L));
    607   if L = 2 then
    608   begin
    609     if (ALine.EdgePoints[0] and $7FFFFFFF) > (ALine.EdgePoints[1] and $7FFFFFFF) then
    610     begin
    611       T := ALine.EdgePoints[0];
    612       ALine.EdgePoints[0] := ALine.EdgePoints[1];
    613       ALine.EdgePoints[1] := T;
    614     end;
    615   end
    616   else if L > SortThreshold then
    617     QuickSort(@ALine.EdgePoints[0], @ALine.EdgePoints[L - 1])
    618   else if L > 2 then
    619     InsertionSort(@ALine.EdgePoints[0], @ALine.EdgePoints[L - 1]);
    620 end;
    621 
    622 procedure SortLines(const ScanLines: TScanLines);
    623 var
    624   I: Integer;
    625 begin
    626   for I := 0 to High(ScanLines) do SortLine(ScanLines[I]);
    627 end;
    628 
    629 
    630 { Routines for rendering polygon edges to scanlines }
    631 
    632 procedure AddEdgePoint(X: Integer; const Y: Integer; const ClipRect: TFixedRect; const ScanLines: TScanLines; const Direction: Integer);
    633 var
    634   L: Integer;
    635   ScanLine: PScanLine;
    636 begin
    637   if (Y < ClipRect.Top) or (Y > ClipRect.Bottom) then Exit;
    638 
    639   if X < ClipRect.Left then
    640     X := ClipRect.Left
    641   else if X > ClipRect.Right then
    642     X := ClipRect.Right;
    643 
    644   // positive direction (+1) is down
    645   if Direction < 0 then
    646     X := Integer(Longword(X) or $80000000); // set the highest bit if the winding is up
    647 
    648   ScanLine := @ScanLines[Y - ClipRect.Top];
    649 
    650   L := ScanLine.Count;
    651   Inc(ScanLine.Count);
    652   if ScanLine.Count > ScanLine.EdgePointsLength then
    653   begin
    654     ScanLine.EdgePointsLength := L + ReallocationThreshold;
    655     ReallocMem(ScanLine.EdgePoints, ScanLine.EdgePointsLength * SizeOf(TEdgePoint));
    656   end;
    657   ScanLine.EdgePoints[L] := X; 
    658 end;
    659 
    660 function DrawEdge(const P1, P2: TFixedPoint; const ClipRect: TFixedRect; const ScanLines: TScanLines): Integer;
    661 var
    662   X, Y: Integer;
    663   I, K: Integer;
    664   Dx, Dy, Sx, Sy: Integer;
    665   Delta: Integer;
    666 begin
    667   // this function 'renders' a line into the edge point (ScanLines) buffer
    668   // and returns the line direction (1 - down, -1 - up, 0 - horizontal)
    669   Result := 0;
    670   if P2.Y = P1.Y then Exit;
    671   Dx := P2.X - P1.X;
    672   Dy := P2.Y - P1.Y;
    673 
    674   if Dy > 0 then Sy := 1
    675   else
    676   begin
    677     Sy := -1;
    678     Dy := -Dy;
    679   end;
    680 
    681   Result := Sy;
    682 
    683   if Dx > 0 then Sx := 1
    684   else
    685   begin
    686     Sx := -1;
    687     Dx := -Dx;
    688   end;
    689 
    690   Delta := (Dx mod Dy) shr 1;
    691   X := P1.X; Y := P1.Y;
    692 
    693   for I := 0 to Dy - 1 do
    694   begin
    695     AddEdgePoint(X, Y, ClipRect, ScanLines, Result);
    696     Inc(Y, Sy);
    697     Inc(Delta, Dx);
    698 
    699     // try it two times and if anything else left, use div and mod
    700     if Delta > Dy then
    701     begin
    702       Inc(X, Sx);
    703       Dec(Delta, Dy);
    704 
    705       if Delta > Dy then  // segment is tilted more than 45 degrees?
    706       begin
    707         Inc(X, Sx);
    708         Dec(Delta, Dy);
    709 
    710         if Delta > Dy then // are we still here?
    711         begin
    712           K := (Delta + Dy - 1) div Dy;
    713           Inc(X, Sx * K);
    714           Dec(Delta, Dy * K);
    715         end;
    716       end;
    717     end;
    718   end;
    719 end;
    720 
    721 
    722 procedure RoundShift1(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation); forward; {$IFDEF USEINLINING} inline; {$ENDIF}
    723 procedure RoundShift2(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation); forward; {$IFDEF USEINLINING} inline; {$ENDIF}
    724 procedure RoundShift4(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation); forward; {$IFDEF USEINLINING} inline; {$ENDIF}
    725 procedure RoundShift8(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation); forward; {$IFDEF USEINLINING} inline; {$ENDIF}
    726 procedure RoundShift16(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation); forward; {$IFDEF USEINLINING} inline; {$ENDIF}
    727 procedure RoundShift32(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation); forward; {$IFDEF USEINLINING} inline; {$ENDIF}
    728 
    729 type
    730   TTransformProc = procedure(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    731   TTransformationAccess = class(TTransformation);
    732 
    733 procedure Transform1(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    734 begin
    735   TTransformationAccess(T).TransformFixed(SrcPoint.X, SrcPoint.Y, DstPoint.X, DstPoint.Y);
    736   RoundShift1(DstPoint, DstPoint, nil);
    737 end;
    738 
    739 procedure RoundShift1(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    740 {$IFDEF USENATIVECODE}
    741 begin
    742   DstPoint.X := (SrcPoint.X + $7F) div 256;
    743   DstPoint.Y := (SrcPoint.Y + $7FFF) div 65536;
    744 {$ELSE}
    745 asm
    746 {$IFDEF TARGET_x64}
    747     MOV EAX, [SrcPoint]
    748     ADD EAX, $0000007F
    749     SAR EAX, 8 // sub-sampled
    750     MOV [DstPoint], EAX
    751     MOV EDX, [SrcPoint + $4]
    752     ADD EDX, $00007FFF
    753     SAR EDX, 16
    754     MOV [DstPoint + $4], EDX
    755 {$ENDIF}
    756 {$IFDEF TARGET_x86}
    757     MOV ECX, [SrcPoint.X]
    758     ADD ECX, $0000007F
    759     SAR ECX, 8 // sub-sampled
    760     MOV [DstPoint.X], ECX
    761     MOV EDX, [SrcPoint.Y]
    762     ADD EDX, $00007FFF
    763     SAR EDX, 16
    764     MOV [DstPoint.Y], EDX
    765 {$ENDIF}
    766 {$ENDIF}
    767 end;
    768 
    769 procedure Transform2(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    770 begin
    771   TTransformationAccess(T).TransformFixed(SrcPoint.X, SrcPoint.Y, DstPoint.X, DstPoint.Y);
    772   RoundShift2(DstPoint, DstPoint, nil);
    773 end;
    774 
    775 procedure RoundShift2(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    776 {$IFDEF USENATIVECODE}
    777 begin
    778   DstPoint.X := (SrcPoint.X + $3FFF) div 32768;
    779   DstPoint.Y := (SrcPoint.Y + $3FFF) div 32768;
    780 {$ELSE}
    781 asm
    782 {$IFDEF TARGET_x64}
    783     MOV EAX, [SrcPoint]
    784     ADD EAX, $00003FFF
    785     SAR EAX, 15
    786     MOV [DstPoint], EAX
    787     MOV EDX, [SrcPoint + $4]
    788     ADD EDX, $00003FFF
    789     SAR EDX, 15
    790     MOV [DstPoint + $4], EDX
    791 {$ENDIF}
    792 {$IFDEF TARGET_x86}
    793     MOV ECX, [SrcPoint.X]
    794     ADD ECX, $00003FFF
    795     SAR ECX, 15
    796     MOV [DstPoint.X], ECX
    797     MOV EDX, [SrcPoint.Y]
    798     ADD EDX, $00003FFF
    799     SAR EDX, 15
    800     MOV [DstPoint.Y], EDX
    801 {$ENDIF}
    802 {$ENDIF}
    803 end;
    804 
    805 procedure Transform4(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    806 begin
    807   TTransformationAccess(T).TransformFixed(SrcPoint.X, SrcPoint.Y, DstPoint.X, DstPoint.Y);
    808   RoundShift4(DstPoint, DstPoint, nil);
    809 end;
    810 
    811 procedure RoundShift4(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    812 {$IFDEF USENATIVECODE}
    813 begin
    814   DstPoint.X := (SrcPoint.X + $1FFF) div 16384;
    815   DstPoint.Y := (SrcPoint.Y + $1FFF) div 16384;
    816 {$ELSE}
    817 asm
    818 {$IFDEF TARGET_x64}
    819     MOV EAX, [SrcPoint]
    820     ADD EAX, $00001FFF
    821     SAR EAX, 14
    822     MOV [DstPoint], EAX
    823     MOV EDX, [SrcPoint + $4]
    824     ADD EDX, $00001FFF
    825     SAR EDX, 14
    826     MOV [DstPoint + $4], EDX
    827 {$ENDIF}
    828 {$IFDEF TARGET_x86}
    829     MOV ECX, [SrcPoint.X]
    830     ADD ECX, $00001FFF
    831     SAR ECX, 14
    832     MOV [DstPoint.X], ECX
    833     MOV EDX, [SrcPoint.Y]
    834     ADD EDX, $00001FFF
    835     SAR EDX, 14
    836     MOV [DstPoint.Y], EDX
    837 {$ENDIF}
    838 {$ENDIF}
    839 end;
    840 
    841 procedure Transform8(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    842 begin
    843   TTransformationAccess(T).TransformFixed(SrcPoint.X, SrcPoint.Y, DstPoint.X, DstPoint.Y);
    844   RoundShift8(DstPoint, DstPoint, nil);
    845 end;
    846 
    847 procedure RoundShift8(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    848 {$IFDEF USENATIVECODE}
    849 begin
    850   DstPoint.X := (SrcPoint.X + $FFF) div 8192;
    851   DstPoint.Y := (SrcPoint.Y + $FFF) div 8192;
    852 {$ELSE}
    853 asm
    854 {$IFDEF TARGET_x64}
    855     MOV EAX, [SrcPoint]
    856     ADD EAX, $00000FFF
    857     SAR EAX, 13
    858     MOV [DstPoint], EAX
    859     MOV EDX, [SrcPoint + $4]
    860     ADD EDX, $00000FFF
    861     SAR EDX, 13
    862     MOV [DstPoint + $4], EDX
    863 {$ENDIF}
    864 {$IFDEF TARGET_x86}
    865     MOV ECX, [SrcPoint.X]
    866     ADD ECX, $00000FFF
    867     SAR ECX, 13
    868     MOV [DstPoint.X], ECX
    869     MOV EDX, [SrcPoint.Y]
    870     ADD EDX, $00000FFF
    871     SAR EDX, 13
    872     MOV [DstPoint.Y], EDX
    873 {$ENDIF}
    874 {$ENDIF}
    875 end;
    876 
    877 procedure Transform16(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    878 begin
    879   TTransformationAccess(T).TransformFixed(SrcPoint.X, SrcPoint.Y, DstPoint.X, DstPoint.Y);
    880   RoundShift16(DstPoint, DstPoint, nil);
    881 end;
    882 
    883 procedure RoundShift16(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    884 {$IFDEF USENATIVECODE}
    885 begin
    886   DstPoint.X := (SrcPoint.X + $7FF) div 4096;
    887   DstPoint.Y := (SrcPoint.Y + $7FF) div 4096;
    888 {$ELSE}
    889 asm
    890 {$IFDEF TARGET_x64}
    891     MOV EAX, [SrcPoint]
    892     ADD EAX, $000007FF
    893     SAR EAX, 12
    894     MOV [DstPoint], EAX
    895     MOV EDX, [SrcPoint + $4]
    896     ADD EDX, $000007FF
    897     SAR EDX, 12
    898     MOV [DstPoint + $4], EDX
    899 {$ENDIF}
    900 {$IFDEF TARGET_x86}
    901     MOV ECX, [SrcPoint.X]
    902     ADD ECX, $000007FF
    903     SAR ECX, 12
    904     MOV [DstPoint.X], ECX
    905     MOV EDX, [SrcPoint.Y]
    906     ADD EDX, $000007FF
    907     SAR EDX, 12
    908     MOV [DstPoint.Y], EDX
    909 {$ENDIF}
    910 {$ENDIF}
    911 end;
    912 
    913 procedure Transform32(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    914 begin
    915   TTransformationAccess(T).TransformFixed(SrcPoint.X, SrcPoint.Y, DstPoint.X, DstPoint.Y);
    916   RoundShift32(DstPoint, DstPoint, nil);
    917 end;
    918 
    919 procedure RoundShift32(var DstPoint: TFixedPoint; const SrcPoint: TFixedPoint; const T: TTransformation);
    920 {$IFDEF USENATIVECODE}
    921 begin
    922   DstPoint.X := (SrcPoint.X + $3FF) div 2048;
    923   DstPoint.Y := (SrcPoint.Y + $3FF) div 2048;
    924 {$ELSE}
    925 asm
    926 {$IFDEF TARGET_x64}
    927     MOV EAX, [SrcPoint]
    928     ADD EAX, $000003FF
    929     SAR EAX, 11
    930     MOV [DstPoint], EAX
    931     MOV EDX, [SrcPoint + $4]
    932     ADD EDX, $000003FF
    933     SAR EDX, 11
    934     MOV [DstPoint + $4], EDX
    935 {$ENDIF}
    936 {$IFDEF TARGET_x86}
    937     MOV ECX, [SrcPoint.X]
    938     ADD ECX, $000003FF
    939     SAR ECX, 11
    940     MOV [DstPoint.X], ECX
    941     MOV EDX, [SrcPoint.Y]
    942     ADD EDX, $000003FF
    943     SAR EDX, 11
    944     MOV [DstPoint.Y], EDX
    945 {$ENDIF}
    946 {$ENDIF}
    947 end;
    948 
    949 const
    950   RoundShiftProcs: array[TAntialiasMode] of TTransformProc = (RoundShift32, RoundShift16, RoundShift8, RoundShift4, RoundShift2, RoundShift1);
    951   TransformProcs:  array[TAntialiasMode] of TTransformProc = (Transform32, Transform16, Transform8, Transform4, Transform2, Transform1);
    952 
    953 procedure AddPolygon(const Points: TArrayOfFixedPoint; const ClipRect: TFixedRect;
    954   var ScanLines: TScanLines; AAMode: TAntialiasMode; Transformation: TTransformation);
    955 var
    956   P1, P2: TFixedPoint;
    957   I: Integer;
    958   PPtr: PFixedPoint;
    959   Transform: TTransformProc;
    960   Direction, PrevDirection: Integer; // up = 1 or down = -1
    961 begin
    962   if Length(Points) < 3 then Exit;
    963 
    964   if Assigned(Transformation) then
    965     Transform := TransformProcs[AAMode]
    966   else
    967     Transform := RoundShiftProcs[AAMode];
    968 
    969   Transform(P1, Points[0], Transformation);
    970 
    971   // find the last Y different from Y1 and get direction
    972   PrevDirection := 0;
    973   I := High(Points);
    974   PPtr := @Points[I];
    975 
    976   while (I > 0) and (PrevDirection = 0) do
    977   begin
    978     Dec(I);
    979     Transform(P2, PPtr^, Transformation); { TODO : optimize minor inefficiency... }
    980     PrevDirection := P1.Y - P2.Y;
    981     Dec(PPtr);
    982   end;
    983 
    984   if PrevDirection > 0 then
    985     PrevDirection := 1
    986   else if PrevDirection < 0 then
    987     PrevDirection := -1
    988   else
    989     PrevDirection := 0;
    990 
    991   PPtr := @Points[1];
    992   for I := 1 to High(Points) do
    993   begin
    994     Transform(P2, PPtr^, Transformation);
    995 
    996     if P1.Y <> P2.Y then
    997     begin
    998       Direction := DrawEdge(P1, P2, ClipRect, ScanLines);
    999       if Direction <> PrevDirection then
    1000       begin
    1001         AddEdgePoint(P1.X, P1.Y, ClipRect, ScanLines, -Direction);
    1002         PrevDirection := Direction;
    1003       end;
    1004     end;
    1005 
    1006     P1 := P2;
    1007     Inc(PPtr);
    1008   end;
    1009 
    1010   Transform(P2, Points[0], Transformation);
    1011 
    1012   if P1.Y <> P2.Y then
    1013   begin
    1014     Direction := DrawEdge(P1, P2, ClipRect, ScanLines);
    1015     if Direction <> PrevDirection then AddEdgePoint(P1.X, P1.Y, ClipRect, ScanLines, -Direction);
    1016   end;
    1017 end;
    1018 
    1019 
    1020 { FillLines routines }
    1021 { These routines rasterize the sorted edge points in the scanlines to
    1022   the bitmap buffer }
    1023 
    1024 procedure ColorFillLines(Bitmap: TCustomBitmap32; BaseY: Integer;
    1025   const ScanLines: TScanLines; Color: TColor32; Mode: TPolyFillMode);
    1026 var
    1027   I, J, L: Integer;
    1028   Top, Left, Right, OldRight, LP, RP, Cx: Integer;
    1029   Winding, NextWinding: Integer;
    1030   HorzLine: procedure(X1, Y, X2: Integer; Value: TColor32) of Object;
    1031 begin
    1032   if Color and $FF000000 <> $FF000000 then
    1033     HorzLine := Bitmap.HorzLineT
    1034   else
    1035     HorzLine := Bitmap.HorzLine;
    1036 
    1037   Cx := Bitmap.ClipRect.Right - 1;
    1038   Top := BaseY - 1;
    1039 
    1040   if Mode = pfAlternate then
    1041     for J := 0 to High(ScanLines) do
    1042     begin
    1043       Inc(Top);
    1044       L := ScanLines[J].Count; // assuming length is even
    1045       if L = 0 then Continue;
    1046       I := 0;
    1047       OldRight := -1;
    1048 
    1049       while I < L do
    1050       begin
    1051         Left := ScanLines[J].EdgePoints[I] and $7FFFFFFF;
    1052         Inc(I);
    1053         Right := ScanLines[J].EdgePoints[I] and $7FFFFFFF - 1;
    1054         if Right > Left then
    1055         begin
    1056           if (Left and $FF) < $80 then Left := Left shr 8
    1057           else Left := Left shr 8 + 1;
    1058 
    1059           if (Right and $FF) < $80 then Right := Right shr 8
    1060           else Right := Right shr 8 + 1;
    1061 
    1062           if Right >= Cx then Right := Cx;
    1063 
    1064           if Left <= OldRight then Left := OldRight + 1;
    1065           OldRight := Right;
    1066           if Right >= Left then HorzLine(Left, Top, Right, Color);
    1067         end;
    1068         Inc(I);
    1069       end
     1329        BlendMemRGB128(Color, Dst[I], Weights64);
     1330      Dec(Count, 2);
     1331      Inc(I, 2);
    10701332    end
    1071   else // Mode = pfWinding
    1072     for J := 0 to High(ScanLines) do
    1073     begin
    1074       Inc(Top);
    1075       L := ScanLines[J].Count; // assuming length is even
    1076       if L = 0 then Continue;
    1077       I := 0;
    1078 
    1079       Winding := 0;
    1080       Left := ScanLines[J].EdgePoints[0];
    1081       if (Left and $80000000) <> 0 then Inc(Winding) else Dec(Winding);
    1082       Left := Left and $7FFFFFFF;
    1083       Inc(I);
    1084 
    1085       while I < L do
    1086       begin
    1087         Right := ScanLines[J].EdgePoints[I];
    1088         if (Right and $80000000) <> 0 then NextWinding := 1 else NextWinding := -1;
    1089         Right := Right and $7FFFFFFF;
    1090         Inc(I);
    1091 
    1092         if Winding <> 0 then
    1093         begin
    1094           if (Left and $FF) < $80 then LP := Left shr 8
    1095           else LP := Left shr 8 + 1;
    1096           if (Right and $FF) < $80 then RP := Right shr 8
    1097           else RP := Right shr 8 + 1;
    1098 
    1099           if RP >= Cx then RP := Cx;
    1100 
    1101           if RP >= LP then HorzLine(LP, Top, RP, Color);
    1102         end;
    1103 
    1104         Inc(Winding, NextWinding);
    1105         Left := Right;
    1106       end;
    1107     end;
    1108 end;
    1109 
    1110 procedure ColorFillLines2(Bitmap: TCustomBitmap32; BaseY: Integer;
    1111   const ScanLines: TScanLines; Color: TColor32; Mode: TPolyFillMode;
    1112   const AAMode: TAntialiasMode = DefaultAAMode);
    1113 var
    1114   I, J, L, N: Integer;
    1115   MinY, MaxY, Y, Top, Bottom: Integer;
    1116   MinX, MaxX, X, Dx: Integer;
    1117   Left, Right: Integer;
    1118   Buffer: array of Integer;
    1119   ColorBuffer: array of TColor32;
    1120   BufferSize: Integer;
    1121   C, A: TColor32;
    1122   ScanLine: PIntegerArray;
    1123   Winding, NextWinding: Integer;
    1124   AAShift, AALines, AAMultiplier: Integer;
    1125   BlendLineEx: TBlendLineEx;
    1126 begin
    1127   A := Color shr 24;
    1128 
    1129   AAShift := AA_SHIFT[AAMode];
    1130   AALines := AA_LINES[AAMode] - 1; // we do the -1 here for optimization.
    1131   AAMultiplier := AA_MULTI[AAMode];
    1132 
    1133   BlendLineEx := BLEND_LINE_EX[Bitmap.CombineMode]^;
    1134 
    1135   // find the range of Y screen coordinates
    1136   MinY := BaseY shr AAShift;
    1137   MaxY := (BaseY + Length(ScanLines) + AALines) shr AAShift;
    1138 
    1139   Y := MinY;
    1140   while Y < MaxY do
    1141   begin
    1142     Top := Y shl AAShift - BaseY;
    1143     Bottom := Top + AALines;
    1144     if Top < 0 then Top := 0;
    1145     if Bottom >= Length(ScanLines) then Bottom := High(ScanLines);
    1146 
    1147     // find left and right edges of the screen scanline
    1148     MinX := $7F000000; MaxX := -$7F000000;
    1149     for J := Top to Bottom do
    1150     begin
    1151       L := ScanLines[J].Count - 1;
    1152       if L > 0 then
    1153       begin
    1154         Left := (ScanLines[J].EdgePoints[0] and $7FFFFFFF);
    1155         Right := (ScanLines[J].EdgePoints[L] and $7FFFFFFF + AALines);
    1156         if Left < MinX then MinX := Left;
    1157         if Right > MaxX then MaxX := Right;
    1158       end
    1159     end;
    1160 
    1161     if MaxX >= MinX then
    1162     begin
    1163       MinX := MinX shr AAShift;
    1164       MaxX := MaxX shr AAShift;
    1165       // allocate buffer for a single scanline
    1166       BufferSize := MaxX - MinX + 2;
    1167       if Length(Buffer) < BufferSize then
    1168       begin
    1169         SetLength(Buffer, BufferSize + 64);
    1170         SetLength(ColorBuffer, BufferSize + 64);
    1171       end;
    1172       FillLongword(Buffer[0], BufferSize, 0);
    1173 
    1174       // ...and fill it
    1175       if Mode = pfAlternate then
    1176         for J := Top to Bottom do
    1177         begin
    1178           I := 0;
    1179           L := ScanLines[J].Count;
    1180           ScanLine := @ScanLines[J].EdgePoints[0];
    1181           while I < L do
    1182           begin
    1183             // Left edge
    1184             X := ScanLine[I] and $7FFFFFFF;
    1185             Dx := X and AALines;
    1186             X := X shr AAShift - MinX;
    1187             Inc(Buffer[X], Dx xor AALines);
    1188             Inc(Buffer[X + 1], Dx);
    1189             Inc(I);
    1190 
    1191             // Right edge
    1192             X := ScanLine[I] and $7FFFFFFF;
    1193             Dx := X and AALines;
    1194             X := X shr AAShift - MinX;
    1195             Dec(Buffer[X], Dx xor AALines);
    1196             Dec(Buffer[X + 1], Dx);
    1197             Inc(I);
    1198           end
    1199         end
    1200       else // mode = pfWinding
    1201         for J := Top to Bottom do
    1202         begin
    1203           I := 0;
    1204           L := ScanLines[J].Count;
    1205           ScanLine := @ScanLines[J].EdgePoints[0];
    1206           Winding := 0;
    1207           while I < L do
    1208           begin
    1209             X := ScanLine[I];
    1210             Inc(I);
    1211             if (X and $80000000) <> 0 then NextWinding := 1 else NextWinding := -1;
    1212             X := X and $7FFFFFFF;
    1213             if Winding = 0 then
    1214             begin
    1215               Dx := X and AALines;
    1216               X := X shr AAShift - MinX;
    1217               Inc(Buffer[X], Dx xor AALines);
    1218               Inc(Buffer[X + 1], Dx);
    1219             end;
    1220             Inc(Winding, NextWinding);
    1221             if Winding = 0 then
    1222             begin
    1223               Dx := X and AALines;
    1224               X := X shr AAShift - MinX;
    1225               Dec(Buffer[X], Dx xor AALines);
    1226               Dec(Buffer[X + 1], Dx);
    1227             end;
    1228           end;
    1229         end;
    1230 
    1231       // integrate the buffer
    1232       N := 0;
    1233       C := Color and $00FFFFFF;
    1234       for I := 0 to BufferSize - 1 do
    1235       begin
    1236         Inc(N, Buffer[I]);
    1237         ColorBuffer[I] := TColor32(N * AAMultiplier and $FF00) shl 16 or C;
    1238       end;
    1239 
    1240       // draw it to the screen
    1241       BlendLineEx(@ColorBuffer[0], Pointer(Bitmap.PixelPtr[MinX, Y]),
    1242         Min(BufferSize, Bitmap.Width - MinX), A);
    1243       EMMS;
    1244     end;
    1245 
    1246     Inc(Y);
    1247   end;
    1248 end;
    1249 
    1250 procedure CustomFillLines(Bitmap: TCustomBitmap32; BaseY: Integer;
    1251   const ScanLines: TScanLines; FillLineCallback: TFillLineEvent; Mode: TPolyFillMode);
    1252 var
    1253   I, J, L: Integer;
    1254   Top, Left, Right, OldRight, LP, RP, Cx: Integer;
    1255   Winding, NextWinding: Integer;
    1256 begin
    1257   Top := BaseY - 1;
    1258   Cx := Bitmap.ClipRect.Right - 1;
    1259 
    1260   if Mode = pfAlternate then
    1261     for J := 0 to High(ScanLines) do
    1262     begin
    1263       Inc(Top);
    1264       L := ScanLines[J].Count; // assuming length is even
    1265       if L = 0 then Continue;
    1266       I := 0;
    1267       OldRight := -1;
    1268 
    1269       while I < L do
    1270       begin
    1271         Left := ScanLines[J].EdgePoints[I] and $7FFFFFFF;
    1272         Inc(I);
    1273         Right := ScanLines[J].EdgePoints[I] and $7FFFFFFF - 1;
    1274         if Right > Left then
    1275         begin
    1276           if (Left and $FF) < $80 then Left := Left shr 8
    1277           else Left := Left shr 8 + 1;
    1278           if (Right and $FF) < $80 then Right := Right shr 8
    1279           else Right := Right shr 8 + 1;
    1280 
    1281           if Right >= Cx then Right := Cx;
    1282 
    1283           if Left <= OldRight then Left := OldRight + 1;
    1284           OldRight := Right;
    1285           if Right >= Left then
    1286             FillLineCallback(Bitmap.PixelPtr[Left, Top], Left, Top, Right - Left, nil);
    1287         end;
    1288         Inc(I);
    1289       end
    1290     end
    1291   else // Mode = pfWinding
    1292     for J := 0 to High(ScanLines) do
    1293     begin
    1294       Inc(Top);
    1295       L := ScanLines[J].Count; // assuming length is even
    1296       if L = 0 then Continue;
    1297       I := 0;
    1298 
    1299       Winding := 0;
    1300       Left := ScanLines[J].EdgePoints[0];
    1301       if (Left and $80000000) <> 0 then Inc(Winding) else Dec(Winding);
    1302       Left := Left and $7FFFFFFF;
    1303       Inc(I);
    1304       while I < L do
    1305       begin
    1306         Right := ScanLines[J].EdgePoints[I];
    1307         if (Right and $80000000) <> 0 then NextWinding := 1 else NextWinding := -1;
    1308         Right := Right and $7FFFFFFF;
    1309         Inc(I);
    1310 
    1311         if Winding <> 0 then
    1312         begin
    1313           if (Left and $FF) < $80 then LP := Left shr 8
    1314           else LP := Left shr 8 + 1;
    1315           if (Right and $FF) < $80 then RP := Right shr 8
    1316           else RP := Right shr 8 + 1;
    1317 
    1318           if RP >= Cx then RP := Cx;
    1319 
    1320           if RP >= LP then
    1321             FillLineCallback(Bitmap.PixelPtr[LP, Top], LP, Top, RP - LP, nil);
    1322         end;
    1323 
    1324         Inc(Winding, NextWinding);
    1325         Left := Right;
    1326       end;
    1327     end;
     1333    {$ENDIF};
    13281334  EMMS;
    13291335end;
    13301336
    1331 procedure CustomFillLines2(Bitmap: TCustomBitmap32; BaseY: Integer;
    1332   const ScanLines: TScanLines; FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
    1333   const AAMode: TAntialiasMode = DefaultAAMode);
    1334 var
    1335   I, J, L, N: Integer;
    1336   MinY, MaxY, Y, Top, Bottom: Integer;
    1337   MinX, MaxX, X, Dx: Integer;
    1338   Left, Right: Integer;
    1339   Buffer: array of Integer;
    1340   AlphaBuffer: array of TColor32;
    1341   BufferSize: Integer;
    1342   ScanLine: PIntegerArray;
    1343   Winding, NextWinding: Integer;
    1344   AAShift, AALines, AAMultiplier: Integer;
    1345 begin
    1346   AAShift := AA_SHIFT[AAMode];
    1347   AALines := AA_LINES[AAMode] - 1; // we do the -1 here for optimization.
    1348   AAMultiplier := AA_MULTI[AAMode];
    1349 
    1350   // find the range of Y screen coordinates
    1351   MinY := BaseY shr AAShift;
    1352   MaxY := (BaseY + Length(ScanLines) + AALines) shr AAShift;
    1353 
    1354   Y := MinY;
    1355   while Y < MaxY do
    1356   begin
    1357     Top := Y shl AAShift - BaseY;
    1358     Bottom := Top + AALines;
    1359     if Top < 0 then Top := 0;
    1360     if Bottom >= Length(ScanLines) then Bottom := High(ScanLines);
    1361 
    1362     // find left and right edges of the screen scanline
    1363     MinX := $7F000000; MaxX := -$7F000000;
    1364     for J := Top to Bottom do
    1365     begin
    1366       L := ScanLines[J].Count - 1;
    1367       if L > 0 then
    1368       begin
    1369         Left := (ScanLines[J].EdgePoints[0] and $7FFFFFFF);
    1370         Right := (ScanLines[J].EdgePoints[L] and $7FFFFFFF + AALines);
    1371         if Left < MinX then MinX := Left;
    1372         if Right > MaxX then MaxX := Right;
    1373       end
    1374     end;
    1375 
    1376     if MaxX >= MinX then
    1377     begin
    1378       MinX := MinX shr AAShift;
    1379       MaxX := MaxX shr AAShift;
    1380       // allocate buffer for a single scanline
    1381       BufferSize := MaxX - MinX + 2;
    1382       if Length(Buffer) < BufferSize then
    1383       begin
    1384         SetLength(Buffer, BufferSize + 64);
    1385         SetLength(AlphaBuffer, BufferSize + 64);
    1386       end;
    1387       FillLongword(Buffer[0], BufferSize, 0);
    1388 
    1389       // ...and fill it
    1390       if Mode = pfAlternate then
    1391         for J := Top to Bottom do
    1392         begin
    1393           I := 0;
    1394           L := ScanLines[J].Count;
    1395           ScanLine := @ScanLines[J].EdgePoints[0];
    1396           while I < L do
    1397           begin
    1398             // Left edge
    1399             X := ScanLine[I] and $7FFFFFFF;
    1400             Dx := X and AALines;
    1401             X := X shr AAShift - MinX;
    1402             Inc(Buffer[X], Dx xor AALines);
    1403             Inc(Buffer[X + 1], Dx);
    1404             Inc(I);
    1405 
    1406             // Right edge
    1407             X := ScanLine[I] and $7FFFFFFF;
    1408             Dx := X and AALines;
    1409             X := X shr AAShift - MinX;
    1410             Dec(Buffer[X], Dx xor AALines);
    1411             Dec(Buffer[X + 1], Dx);
    1412             Inc(I);
    1413           end
    1414         end
    1415       else // mode = pfWinding
    1416         for J := Top to Bottom do
    1417         begin
    1418           I := 0;
    1419           L := ScanLines[J].Count;
    1420           ScanLine := @ScanLines[J].EdgePoints[0];
    1421           Winding := 0;
    1422           while I < L do
    1423           begin
    1424             X := ScanLine[I];
    1425             Inc(I);
    1426             if (X and $80000000) <> 0 then NextWinding := 1 else NextWinding := -1;
    1427             X := X and $7FFFFFFF;
    1428             if Winding = 0 then
    1429             begin
    1430               Dx := X and AALines;
    1431               X := X shr AAShift - MinX;
    1432               Inc(Buffer[X], Dx xor AALines);
    1433               Inc(Buffer[X + 1], Dx);
    1434             end;
    1435             Inc(Winding, NextWinding);
    1436             if Winding = 0 then
    1437             begin
    1438               Dx := X and AALines;
    1439               X := X shr AAShift - MinX;
    1440               Dec(Buffer[X], Dx xor AALines);
    1441               Dec(Buffer[X + 1], Dx);
    1442             end;
    1443           end;
    1444         end;
    1445 
    1446       // integrate the buffer
    1447       N := 0;
    1448       for I := 0 to BufferSize - 1 do
    1449       begin
    1450         Inc(N, Buffer[I]);
    1451         AlphaBuffer[I] := (N * AAMultiplier) shr 8;
    1452       end;
    1453 
    1454       // draw it to the screen
    1455       FillLineCallback(Pointer(Bitmap.PixelPtr[MinX, Y]), MinX, Y, BufferSize, @AlphaBuffer[0]);
    1456       EMMS;
    1457     end;
    1458 
    1459     Inc(Y);
    1460   end;
    1461 end;
    1462 
    1463 
    1464 { Helper routines for drawing Polygons and PolyPolygons }
    1465 
    1466 procedure RenderPolyPolygon(Bitmap: TCustomBitmap32;
    1467   const Points: TArrayOfArrayOfFixedPoint; Color: TColor32;
    1468   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
    1469   const AAMode: TAntialiasMode; Transformation: TTransformation);
    1470 var
    1471   ChangedRect, DstRect: TFixedRect;
    1472   P: TFixedPoint;
    1473   AAShift: Integer;
    1474   I: Integer;
    1475   ScanLines: TScanLines;
    1476 begin
    1477   if not Bitmap.MeasuringMode then
    1478   begin
    1479     ChangedRect := PolyPolygonBounds(Points, Transformation);
    1480 
    1481     with DstRect do
    1482     if AAMode <> amNone then
    1483     begin
    1484       AAShift := AA_SHIFT[AAMode];
    1485       Left := Bitmap.ClipRect.Left shl AAShift;
    1486       Right := Bitmap.ClipRect.Right shl AAShift - 1;
    1487       Top := Bitmap.ClipRect.Top shl AAShift;
    1488       Bottom := Bitmap.ClipRect.Bottom shl AAShift - 1;
    1489 
    1490       P.X := ChangedRect.Top;
    1491       P.Y := ChangedRect.Bottom;
    1492       RoundShiftProcs[AAMode](P, P, nil);
    1493       Top := Constrain(P.X, Top, Bottom);
    1494       Bottom := Constrain(P.Y, Top, Bottom);
    1495     end
    1496     else
    1497     begin
    1498       Left := Bitmap.ClipRect.Left shl 8;
    1499       Right := Bitmap.ClipRect.Right shl 8 - 1;
    1500       Top := Constrain(SAR_16(ChangedRect.Top + $00007FFF),
    1501         Bitmap.ClipRect.Top, Bitmap.ClipRect.Bottom - 1);
    1502       Bottom := Constrain(SAR_16(ChangedRect.Bottom + $00007FFF),
    1503         Bitmap.ClipRect.Top, Bitmap.ClipRect.Bottom - 1);
    1504     end;
    1505 
    1506     if DstRect.Top >= DstRect.Bottom then Exit;
    1507 
    1508     ScanLinesCreate(ScanLines, DstRect.Bottom - DstRect.Top + 1);
    1509     for I := 0 to High(Points) do
    1510       AddPolygon(Points[I], DstRect, ScanLines, AAMode, Transformation);
    1511 
    1512     SortLines(ScanLines);
    1513     Bitmap.BeginUpdate;
    1514     try
    1515       if AAMode <> amNone then
    1516         if Assigned(FillLineCallback) then
    1517           CustomFillLines2(Bitmap, DstRect.Top, ScanLines, FillLineCallback, Mode, AAMode)
    1518         else
    1519           ColorFillLines2(Bitmap, DstRect.Top, ScanLines, Color, Mode, AAMode)
    1520       else
    1521         if Assigned(FillLineCallback) then
    1522           CustomFillLines(Bitmap, DstRect.Top, ScanLines, FillLineCallback, Mode)
    1523         else
    1524           ColorFillLines(Bitmap, DstRect.Top, ScanLines, Color, Mode);
    1525     finally
    1526       Bitmap.EndUpdate;
    1527       ScanLinesDestroy(ScanLines);
    1528     end;
    1529     Bitmap.Changed(MakeRect(ChangedRect, rrOutside));
    1530   end
    1531   else
    1532     Bitmap.Changed(MakeRect(PolyPolygonBounds(Points, Transformation), rrOutside));
    1533 end;
    1534 
    1535 procedure RenderPolygon(Bitmap: TCustomBitmap32;
    1536   const Points: TArrayOfFixedPoint; Color: TColor32;
    1537   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
    1538   const AAMode: TAntialiasMode; Transformation: TTransformation);
    1539 var
    1540   H: TArrayOfArrayOfFixedPoint;
    1541 begin
    1542   SetLength(H, 1);
    1543   H[0] := Points;
    1544   RenderPolyPolygon(Bitmap, H, Color, FillLineCallback, Mode, AAMode, Transformation);
    1545   H[0] := nil;
    1546 end;
    1547 
    1548 
    1549 { Polygons }
    1550 
    1551 procedure PolygonTS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    1552   Color: TColor32; Mode: TPolyFillMode; Transformation: TTransformation);
    1553 begin
    1554   RenderPolygon(Bitmap, Points, Color, nil, Mode, amNone, Transformation);
    1555 end;
    1556 
    1557 procedure PolygonTS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    1558   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
    1559   Transformation: TTransformation);
    1560 begin
    1561   RenderPolygon(Bitmap, Points, 0, FillLineCallback, Mode, amNone, Transformation);
    1562 end;
    1563 
    1564 procedure PolygonTS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    1565   Filler: TCustomPolygonFiller; Mode: TPolyFillMode;
    1566   Transformation: TTransformation);
    1567 begin
    1568   RenderPolygon(Bitmap, Points, 0, Filler.FillLine, Mode, amNone, Transformation);
    1569 end;
    1570 
    1571 procedure PolygonXS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    1572   Color: TColor32; Mode: TPolyFillMode;
    1573   const AAMode: TAntialiasMode; Transformation: TTransformation);
    1574 begin
    1575   RenderPolygon(Bitmap, Points, Color, nil, Mode, AAMode, Transformation);
    1576 end;
    1577 
    1578 procedure PolygonXS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    1579   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
    1580   const AAMode: TAntialiasMode; Transformation: TTransformation);
    1581 begin
    1582   RenderPolygon(Bitmap, Points, 0, FillLineCallback, Mode, AAMode, Transformation);
    1583 end;
    1584 
    1585 procedure PolygonXS(Bitmap: TCustomBitmap32; const Points: TArrayOfFixedPoint;
    1586   Filler: TCustomPolygonFiller; Mode: TPolyFillMode;
    1587   const AAMode: TAntialiasMode; Transformation: TTransformation);
    1588 begin
    1589   RenderPolygon(Bitmap, Points, 0, Filler.FillLine, Mode, AAMode, Transformation);
    1590 end;
    1591 
    1592 
    1593 { PolyPolygons }
    1594 
    1595 procedure PolyPolygonTS(Bitmap: TCustomBitmap32;
    1596   const Points: TArrayOfArrayOfFixedPoint; Color: TColor32; Mode: TPolyFillMode;
    1597   Transformation: TTransformation);
    1598 begin
    1599   RenderPolyPolygon(Bitmap, Points, Color, nil, Mode, amNone, Transformation);
    1600 end;
    1601 
    1602 procedure PolyPolygonTS(Bitmap: TCustomBitmap32;
    1603   const Points: TArrayOfArrayOfFixedPoint; FillLineCallback: TFillLineEvent;
    1604   Mode: TPolyFillMode; Transformation: TTransformation);
    1605 begin
    1606   RenderPolyPolygon(Bitmap, Points, 0, FillLineCallback, Mode, amNone, Transformation);
    1607 end;
    1608 
    1609 procedure PolyPolygonTS(Bitmap: TCustomBitmap32;
    1610   const Points: TArrayOfArrayOfFixedPoint; Filler: TCustomPolygonFiller;
    1611   Mode: TPolyFillMode; Transformation: TTransformation);
    1612 begin
    1613   RenderPolyPolygon(Bitmap, Points, 0, Filler.FillLine, Mode, amNone, Transformation);
    1614 end;
    1615 
    1616 procedure PolyPolygonXS(Bitmap: TCustomBitmap32;
    1617   const Points: TArrayOfArrayOfFixedPoint; Color: TColor32; Mode: TPolyFillMode;
    1618   const AAMode: TAntialiasMode; Transformation: TTransformation);
    1619 begin
    1620   RenderPolyPolygon(Bitmap, Points, Color, nil, Mode, AAMode, Transformation);
    1621 end;
    1622 
    1623 procedure PolyPolygonXS(Bitmap: TCustomBitmap32;
    1624   const Points: TArrayOfArrayOfFixedPoint; FillLineCallback: TFillLineEvent;
    1625   Mode: TPolyFillMode; const AAMode: TAntialiasMode;
    1626   Transformation: TTransformation);
    1627 begin
    1628   RenderPolyPolygon(Bitmap, Points, 0, FillLineCallback, Mode, AAMode, Transformation);
    1629 end;
    1630 
    1631 procedure PolyPolygonXS(Bitmap: TCustomBitmap32;
    1632   const Points: TArrayOfArrayOfFixedPoint; Filler: TCustomPolygonFiller;
    1633   Mode: TPolyFillMode; const AAMode: TAntialiasMode;
    1634   Transformation: TTransformation);
    1635 begin
    1636   RenderPolyPolygon(Bitmap, Points, 0, Filler.FillLine, Mode, AAMode, Transformation);
    1637 end;
    1638 
    1639 
    1640 { Helper routines }
    1641 
    1642 function PolygonBounds(const Points: TArrayOfFixedPoint;
    1643   Transformation: TTransformation): TFixedRect;
    1644 var
    1645   I: Integer;
    1646 begin
    1647   with Result do
    1648   begin
    1649     Left := $7FFFFFFF;
    1650     Right := -$7FFFFFFF;
    1651     Top := $7FFFFFFF;
    1652     Bottom := -$7FFFFFFF;
    1653 
    1654     if Assigned(Transformation) then
    1655     begin
    1656       for I := 0 to High(Points) do
    1657       with Transformation.Transform(Points[I]) do
    1658       begin
    1659         if X < Left   then Left := X;
    1660         if X > Right  then Right := X;
    1661         if Y < Top    then Top := Y;
    1662         if Y > Bottom then Bottom := Y;
    1663       end
    1664     end
    1665     else
    1666       for I := 0 to High(Points) do
    1667       with Points[I] do
    1668       begin
    1669         if X < Left   then Left := X;
    1670         if X > Right  then Right := X;
    1671         if Y < Top    then Top := Y;
    1672         if Y > Bottom then Bottom := Y;
    1673       end;
    1674   end;
    1675 end;
    1676 
    1677 function PolyPolygonBounds(const Points: TArrayOfArrayOfFixedPoint;
    1678   Transformation: TTransformation): TFixedRect;
    1679 var
    1680   I, J: Integer;
    1681 begin
    1682   with Result do
    1683   begin
    1684     Left := $7FFFFFFF;
    1685     Right := -$7FFFFFFF;
    1686     Top := $7FFFFFFF;
    1687     Bottom := -$7FFFFFFF;
    1688 
    1689     if Assigned(Transformation) then
    1690       for I := 0 to High(Points) do
    1691         for J := 0 to High(Points[I]) do
    1692         with Transformation.Transform(Points[I, J]) do
    1693         begin
    1694           if X < Left   then Left := X;
    1695           if X > Right  then Right := X;
    1696           if Y < Top    then Top := Y;
    1697           if Y > Bottom then Bottom := Y;
    1698         end
    1699     else
    1700       for I := 0 to High(Points) do
    1701         for J := 0 to High(Points[I]) do
    1702         with Points[I, J] do
    1703         begin
    1704           if X < Left   then Left := X;
    1705           if X > Right  then Right := X;
    1706           if Y < Top    then Top := Y;
    1707           if Y > Bottom then Bottom := Y;
    1708         end;
    1709   end;
    1710 end;
    1711 
    1712 function PtInPolygon(const Pt: TFixedPoint; const Points: TArrayOfFixedPoint): Boolean;
    1713 var
    1714   I: Integer;
    1715   iPt, jPt: PFixedPoint;
    1716 begin
    1717   Result := False;
    1718   iPt := @Points[0];
    1719   jPt := @Points[High(Points)];
    1720   for I := 0 to High(Points) do
    1721   begin
    1722     Result := Result xor (((Pt.Y >= iPt.Y) xor (Pt.Y >= jPt.Y)) and
    1723       (Pt.X - iPt.X < MulDiv(jPt.X - iPt.X, Pt.Y - iPt.Y, jPt.Y - iPt.Y)));
    1724     jPt := iPt;
    1725     Inc(iPt);
    1726   end;
    1727 end;
    1728 
    1729 { TPolygon32 }
    1730 
    1731 procedure TPolygon32.Add(const P: TFixedPoint);
    1732 var
    1733   H, L: Integer;
    1734 begin
    1735   H := High(Points);
    1736   L := Length(Points[H]);
    1737   SetLength(Points[H], L + 1);
    1738   Points[H][L] := P;
    1739   Normals := nil;
    1740 end;
    1741 
    1742 procedure TPolygon32.AddPoints(var First: TFixedPoint; Count: Integer);
    1743 var
    1744   H, L, I: Integer;
    1745 begin
    1746   H := High(Points);
    1747   L := Length(Points[H]);
    1748   SetLength(Points[H], L + Count);
    1749   for I := 0 to Count - 1 do
    1750     Points[H, L + I] := PFixedPointArray(@First)[I];
    1751   Normals := nil;
    1752 end;
    1753 
    1754 procedure TPolygon32.CopyPropertiesTo(Dst: TPolygon32);
    1755 begin
    1756   Dst.Antialiased := Antialiased;
    1757   Dst.AntialiasMode := AntialiasMode;
    1758   Dst.Closed := Closed;
    1759   Dst.FillMode := FillMode;
    1760 end;
    1761 
    1762 procedure TPolygon32.AssignTo(Dst: TPersistent);
    1763 var
    1764   DstPolygon: TPolygon32;
    1765   Index: Integer;
    1766 begin
    1767   if Dst is TPolygon32 then
    1768   begin
    1769     DstPolygon := TPolygon32(Dst);
    1770     CopyPropertiesTo(DstPolygon);
    1771     SetLength(DstPolygon.FNormals, Length(Normals));
    1772     for Index := 0 to Length(Normals) - 1 do
    1773     begin
    1774       DstPolygon.Normals[Index] := Copy(Normals[Index]);
    1775     end;
    1776 
    1777     SetLength(DstPolygon.FPoints, Length(Points));
    1778     for Index := 0 to Length(Points) - 1 do
    1779     begin
    1780       DstPolygon.Points[Index] := Copy(Points[Index]);
    1781     end;
    1782   end
    1783   else
    1784     inherited;
    1785 end;
    1786 
    1787 function TPolygon32.GetBoundingRect: TFixedRect;
    1788 begin
    1789   Result := PolyPolygonBounds(Points);
    1790 end;
    1791 
    1792 procedure TPolygon32.BuildNormals;
    1793 var
    1794   I, J, Count, NextI: Integer;
    1795   dx, dy, f: Single;
    1796 begin
    1797   if Length(Normals) <> 0 then Exit;
    1798   SetLength(FNormals, Length(Points));
    1799 
    1800   for J := 0 to High(Points) do
    1801   begin
    1802     Count := Length(Points[J]);
    1803     SetLength(Normals[J], Count);
    1804 
    1805     if Count = 0 then Continue;
    1806     if Count = 1 then
    1807     begin
    1808       FillChar(Normals[J][0], SizeOf(TFixedPoint), 0);
    1809       Continue;
    1810     end;
    1811 
    1812     I := 0;
    1813     NextI := 1;
    1814     dx := 0;
    1815     dy := 0;
    1816 
    1817     while I < Count do
    1818     begin
    1819       if Closed and (NextI >= Count) then NextI := 0;
    1820       if NextI < Count then
    1821       begin
    1822         dx := (Points[J][NextI].X - Points[J][I].X) / $10000;
    1823         dy := (Points[J][NextI].Y - Points[J][I].Y) / $10000;
    1824       end;
    1825       if (dx <> 0) or (dy <> 0) then
    1826       begin
    1827         f := 1 / GR32_Math.Hypot(dx, dy);
    1828         dx := dx * f;
    1829         dy := dy * f;
    1830       end;
    1831       with Normals[J][I] do
    1832       begin
    1833         X := Fixed(dy);
    1834         Y := Fixed(-dx);
    1835       end;
    1836       Inc(I);
    1837       Inc(NextI);
    1838     end;
    1839   end;
    1840 end;
    1841 
    1842 procedure TPolygon32.Clear;
    1843 begin
    1844   Points := nil;
    1845   Normals := nil;
    1846   NewLine;
    1847 end;
    1848 
    1849 function TPolygon32.ContainsPoint(const P: TFixedPoint): Boolean;
    1850 var
    1851   I: Integer;
    1852 begin
    1853   Result := False;
    1854   for I := 0 to High(FPoints) do
    1855     if PtInPolygon(P, FPoints[I]) then
    1856     begin
    1857       Result := True;
    1858       Exit;
    1859     end;
    1860 end;
    1861 
    1862 constructor TPolygon32.Create;
    1863 begin
    1864   inherited;
    1865   FClosed := True;
    1866   FAntialiasMode := DefaultAAMode;
    1867   NewLine; // initiate a new contour
    1868 end;
    1869 
    1870 destructor TPolygon32.Destroy;
    1871 begin
    1872   Clear;
    1873   inherited;
    1874 end;
    1875 
    1876 procedure TPolygon32.Draw(Bitmap: TCustomBitmap32; OutlineColor, FillColor: TColor32; Transformation: TTransformation);
    1877 begin
    1878   Bitmap.BeginUpdate;
    1879 
    1880   if Antialiased then
    1881   begin
    1882     if (FillColor and $FF000000) <> 0 then
    1883       PolyPolygonXS(Bitmap, Points, FillColor, FillMode, AntialiasMode, Transformation);
    1884     if (OutlineColor and $FF000000) <> 0 then
    1885       PolyPolylineXS(Bitmap, Points, OutlineColor, Closed, Transformation);
    1886   end
    1887   else
    1888   begin
    1889     if (FillColor and $FF000000) <> 0 then
    1890       PolyPolygonTS(Bitmap, Points, FillColor, FillMode, Transformation);
    1891     if (OutlineColor and $FF000000) <> 0 then
    1892       PolyPolylineTS(Bitmap, Points, OutlineColor, Closed, Transformation);
    1893   end;
    1894 
    1895   Bitmap.EndUpdate;
    1896   Bitmap.Changed;
    1897 end;
    1898 
    1899 procedure TPolygon32.Draw(Bitmap: TCustomBitmap32; OutlineColor: TColor32;
    1900   FillCallback: TFillLineEvent; Transformation: TTransformation);
    1901 begin
    1902   Bitmap.BeginUpdate;
    1903 
    1904   if Antialiased then
    1905   begin
    1906 {$IFDEF FPC}
    1907     RenderPolyPolygon(Bitmap, Points, 0, FillCallback, FillMode, AntialiasMode, Transformation);
    1908 {$ELSE}
    1909     PolyPolygonXS(Bitmap, Points, FillCallback, FillMode, AntialiasMode, Transformation);
    1910 {$ENDIF}
    1911     if (OutlineColor and $FF000000) <> 0 then
    1912       PolyPolylineXS(Bitmap, Points, OutlineColor, Closed, Transformation);
    1913   end
    1914   else
    1915   begin
    1916 {$IFDEF FPC}
    1917     RenderPolyPolygon(Bitmap, Points, 0, FillCallback, FillMode, amNone, Transformation);
    1918 {$ELSE}
    1919     PolyPolygonTS(Bitmap, Points, FillCallback, FillMode, Transformation);
    1920 {$ENDIF}
    1921     if (OutlineColor and $FF000000) <> 0 then
    1922       PolyPolylineTS(Bitmap, Points, OutlineColor, Closed, Transformation);
    1923   end;
    1924 
    1925   Bitmap.EndUpdate;
    1926   Bitmap.Changed;
    1927 end;
    1928 
    1929 procedure TPolygon32.Draw(Bitmap: TCustomBitmap32; OutlineColor: TColor32;
    1930   Filler: TCustomPolygonFiller; Transformation: TTransformation);
    1931 begin
    1932 {$IFDEF FPC}
    1933   Bitmap.BeginUpdate;
    1934 
    1935   if Antialiased then
    1936   begin
    1937     RenderPolyPolygon(Bitmap, Points, 0, Filler.FillLine, FillMode, AntialiasMode, Transformation);
    1938     if (OutlineColor and $FF000000) <> 0 then
    1939       PolyPolylineXS(Bitmap, Points, OutlineColor, Closed, Transformation);
    1940   end
    1941   else
    1942   begin
    1943     RenderPolyPolygon(Bitmap, Points, 0, Filler.FillLine, FillMode, amNone, Transformation);
    1944     if (OutlineColor and $FF000000) <> 0 then
    1945       PolyPolylineTS(Bitmap, Points, OutlineColor, Closed, Transformation);
    1946   end;
    1947 
    1948   Bitmap.EndUpdate;
    1949   Bitmap.Changed;
    1950 
    1951 {$ELSE}
    1952   Draw(Bitmap, OutlineColor, Filler.FillLine, Transformation);
    1953 {$ENDIF}
    1954 end;
    1955 
    1956 procedure TPolygon32.DrawEdge(Bitmap: TCustomBitmap32; Color: TColor32; Transformation: TTransformation);
    1957 begin
    1958   Bitmap.BeginUpdate;
    1959 
    1960   if Antialiased then
    1961     PolyPolylineXS(Bitmap, Points, Color, Closed, Transformation)
    1962   else
    1963     PolyPolylineTS(Bitmap, Points, Color, Closed, Transformation);
    1964 
    1965   Bitmap.EndUpdate;
    1966   Bitmap.Changed;
    1967 end;
    1968 
    1969 procedure TPolygon32.DrawFill(Bitmap: TCustomBitmap32; Color: TColor32; Transformation: TTransformation);
    1970 begin
    1971   Bitmap.BeginUpdate;
    1972 
    1973   if Antialiased then
    1974     PolyPolygonXS(Bitmap, Points, Color, FillMode, AntialiasMode, Transformation)
    1975   else
    1976     PolyPolygonTS(Bitmap, Points, Color, FillMode, Transformation);
    1977 
    1978   Bitmap.EndUpdate;
    1979   Bitmap.Changed;
    1980 end;
    1981 
    1982 procedure TPolygon32.DrawFill(Bitmap: TCustomBitmap32; FillCallback: TFillLineEvent;
    1983   Transformation: TTransformation);
    1984 begin
    1985   Bitmap.BeginUpdate;
    1986 
    1987 {$IFDEF FPC}
    1988   if Antialiased then
    1989     RenderPolyPolygon(Bitmap, Points, 0, FillCallback, FillMode, AntialiasMode, Transformation)
    1990   else
    1991     RenderPolyPolygon(Bitmap, Points, 0, FillCallback, FillMode, amNone, Transformation);
    1992 {$ELSE}
    1993   if Antialiased then
    1994     PolyPolygonXS(Bitmap, Points, FillCallback, FillMode, AntialiasMode, Transformation)
    1995   else
    1996     PolyPolygonTS(Bitmap, Points, FillCallback, FillMode, Transformation);
    1997 {$ENDIF}
    1998 
    1999   Bitmap.EndUpdate;
    2000   Bitmap.Changed;
    2001 end;
    2002 
    2003 procedure TPolygon32.DrawFill(Bitmap: TCustomBitmap32; Filler: TCustomPolygonFiller;
    2004   Transformation: TTransformation);
    2005 begin
    2006 {$IFDEF FPC}
    2007   Bitmap.BeginUpdate;
    2008   if Antialiased then
    2009     RenderPolyPolygon(Bitmap, Points, 0, Filler.FillLine, FillMode, AntialiasMode, Transformation)
    2010   else
    2011     RenderPolyPolygon(Bitmap, Points, 0, Filler.FillLine, FillMode, amNone, Transformation);
    2012 
    2013   Bitmap.EndUpdate;
    2014   Bitmap.Changed;
    2015 {$ELSE}
    2016   DrawFill(Bitmap, Filler.FillLine, Transformation);
    2017 {$ENDIF}
    2018 end;
    2019 
    2020 function TPolygon32.Grow(const Delta: TFixed; EdgeSharpness: Single = 0): TPolygon32;
    2021 var
    2022   J, I, PrevI: Integer;
    2023   PX, PY, AX, AY, BX, BY, CX, CY, R, D, E: Integer;
    2024 
    2025   procedure AddPoint(LongDeltaX, LongDeltaY: Integer);
    2026   var
    2027     N, L: Integer;
    2028   begin
    2029     with Result do
    2030     begin
    2031       N := High(Points);
    2032       L := Length(Points[N]);
    2033       SetLength(Points[N], L + 1);
    2034     end;
    2035     with Result.Points[N][L] do
    2036     begin
    2037       X := PX + LongDeltaX;
    2038       Y := PY + LongDeltaY;
    2039     end;
    2040   end;
    2041 
    2042 begin
    2043   BuildNormals;
    2044 
    2045   if EdgeSharpness > 0.99 then
    2046     EdgeSharpness := 0.99
    2047   else if EdgeSharpness < 0 then
    2048     EdgeSharpness := 0;
    2049 
    2050   D := Delta;
    2051   E := Round(D * (1 - EdgeSharpness));
    2052 
    2053   Result := TPolygon32.Create;
    2054   CopyPropertiesTo(Result);
    2055 
    2056   if Delta = 0 then
    2057   begin
    2058     // simply copy the data
    2059     SetLength(Result.FPoints, Length(Points));
    2060     for J := 0 to High(Points) do
    2061       Result.Points[J] := Copy(Points[J], 0, Length(Points[J]));
    2062     Exit;
    2063   end;
    2064 
    2065   Result.Points := nil;
    2066 
    2067   for J := 0 to High(Points) do
    2068   begin
    2069     if Length(Points[J]) < 2 then Continue;
    2070 
    2071     Result.NewLine;
    2072 
    2073     for I := 0 to High(Points[J]) do
    2074     begin
    2075       with Points[J][I] do
    2076       begin
    2077         PX := X;
    2078         PY := Y;
    2079       end;
    2080 
    2081       with Normals[J][I] do
    2082       begin
    2083         BX := MulDiv(X, D, $10000);
    2084         BY := MulDiv(Y, D, $10000);
    2085       end;
    2086 
    2087       if (I > 0) or Closed then
    2088       begin
    2089         PrevI := I - 1;
    2090         if PrevI < 0 then PrevI := High(Points[J]);
    2091         with Normals[J][PrevI] do
    2092         begin
    2093           AX := MulDiv(X, D, $10000);
    2094           AY := MulDiv(Y, D, $10000);
    2095         end;
    2096 
    2097         if (I = High(Points[J])) and (not Closed) then AddPoint(AX, AY)
    2098         else
    2099         begin
    2100           CX := AX + BX;
    2101           CY := AY + BY;
    2102           R := MulDiv(AX, CX, D) + MulDiv(AY, CY, D);
    2103           if R > E then AddPoint(MulDiv(CX, D, R), MulDiv(CY, D, R))
    2104           else
    2105           begin
    2106             AddPoint(AX, AY);
    2107             AddPoint(BX, BY);
    2108           end;
    2109         end;
    2110       end
    2111       else AddPoint(BX, BY);
    2112     end;
    2113   end;
    2114 end;
    2115 
    2116 procedure TPolygon32.NewLine;
    2117 begin
    2118   SetLength(FPoints, Length(Points) + 1);
    2119   Normals := nil;
    2120 end;
    2121 
    2122 procedure TPolygon32.Offset(const Dx, Dy: TFixed);
    2123 var
    2124   J, I: Integer;
    2125 begin
    2126   for J := 0 to High(Points) do
    2127     for I := 0 to High(Points[J]) do
    2128       with Points[J][I] do
    2129       begin
    2130         Inc(X, Dx);
    2131         Inc(Y, Dy);
    2132       end;
    2133 end;
    2134 
    2135 function TPolygon32.Outline: TPolygon32;
    2136 var
    2137   J, I, L, H: Integer;
    2138 begin
    2139   BuildNormals;
    2140 
    2141   Result := TPolygon32.Create;
    2142   CopyPropertiesTo(Result);
    2143 
    2144   Result.Points := nil;
    2145 
    2146   for J := 0 to High(Points) do
    2147   begin
    2148     if Length(Points[J]) < 2 then Continue;
    2149 
    2150     if Closed then
    2151     begin
    2152       Result.NewLine;
    2153       for I := 0 to High(Points[J]) do Result.Add(Points[J][I]);
    2154       Result.NewLine;
    2155       for I := High(Points[J]) downto 0 do Result.Add(Points[J][I]);
    2156     end
    2157     else // not closed
    2158     begin
    2159       // unrolled...
    2160       SetLength(Result.FPoints, Length(Result.FPoints) + 1);
    2161       Result.FNormals:= nil;
    2162 
    2163       L:= Length(Points[J]);
    2164       H:= High(Result.FPoints);
    2165       SetLength(Result.FPoints[H], L * 2);
    2166       for I := 0 to High(Points[J]) do
    2167         Result.FPoints[H][I]:= (Points[J][I]);
    2168       for I := High(Points[J]) downto 0 do
    2169         Result.FPoints[H][2 * L - (I + 1)]:= (Points[J][I]);
    2170     end;
    2171   end;
    2172 end;
    2173 
    2174 procedure TPolygon32.Transform(Transformation: TTransformation);
    2175 begin
    2176   Points := TransformPoints(Points, Transformation);
    2177 end;
     1337{ TCustomPolygonFiller }
     1338
     1339procedure TCustomPolygonFiller.BeginRendering;
     1340begin
     1341  // implemented by descendants
     1342end;
     1343
     1344procedure TCustomPolygonFiller.EndRendering;
     1345begin
     1346  // implemented by descendants
     1347end;
     1348
     1349{ TCallbackPolygonFiller }
     1350
     1351function TCallbackPolygonFiller.GetFillLine: TFillLineEvent;
     1352begin
     1353  Result := FFillLineEvent;
     1354end;
     1355
     1356
     1357{ TInvertPolygonFiller }
     1358
     1359procedure TInvertPolygonFiller.FillLineBlend(Dst: PColor32; DstX, DstY,
     1360  Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
     1361var
     1362  X: Integer;
     1363  BlendMemEx: TBlendMemEx;
     1364begin
     1365  BlendMemEx := BLEND_MEM_EX[CombineMode]^;
     1366  for X := DstX to DstX + Length - 1 do
     1367  begin
     1368    BlendMemEx(InvertColor(Dst^), Dst^, AlphaValues^);
     1369    EMMS;
     1370    Inc(Dst);
     1371    Inc(AlphaValues);
     1372  end;
     1373end;
     1374
     1375function TInvertPolygonFiller.GetFillLine: TFillLineEvent;
     1376begin
     1377  Result := FillLineBlend;
     1378end;
     1379
     1380
     1381{ TClearPolygonFiller }
     1382
     1383constructor TClearPolygonFiller.Create(Color: TColor32 = $00808080);
     1384begin
     1385  inherited Create;
     1386  FColor := Color;
     1387end;
     1388
     1389procedure TClearPolygonFiller.FillLineClear(Dst: PColor32; DstX, DstY,
     1390  Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
     1391begin
     1392  FillLongword(Dst^, Length, FColor);
     1393end;
     1394
     1395function TClearPolygonFiller.GetFillLine: TFillLineEvent;
     1396begin
     1397  Result := FillLineClear;
     1398end;
     1399
    21781400
    21791401{ TBitmapPolygonFiller }
    21801402
    21811403procedure TBitmapPolygonFiller.FillLineOpaque(Dst: PColor32; DstX, DstY,
    2182   Length: Integer; AlphaValues: PColor32);
     1404  Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
    21831405var
    21841406  PatternX, PatternY, X: Integer;
     
    22231445end;
    22241446
    2225 procedure TBitmapPolygonFiller.FillLineBlend(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
     1447procedure TBitmapPolygonFiller.FillLineBlend(Dst: PColor32; DstX, DstY,
     1448  Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
    22261449var
    22271450  PatternX, PatternY, X: Integer;
     
    22681491end;
    22691492
    2270 procedure TBitmapPolygonFiller.FillLineBlendMasterAlpha(Dst: PColor32; DstX, DstY,
    2271   Length: Integer; AlphaValues: PColor32);
     1493procedure TBitmapPolygonFiller.FillLineBlendMasterAlpha(Dst: PColor32;
     1494  DstX, DstY, Length: Integer; AlphaValues: PColor32;
     1495  CombineMode: TCombineMode);
    22721496var
    22731497  PatternX, PatternY, X: Integer;
     
    23091533end;
    23101534
    2311 procedure TBitmapPolygonFiller.FillLineCustomCombine(Dst: PColor32; DstX, DstY,
    2312   Length: Integer; AlphaValues: PColor32);
     1535procedure TBitmapPolygonFiller.FillLineCustomCombine(Dst: PColor32;
     1536  DstX, DstY, Length: Integer; AlphaValues: PColor32;
     1537  CombineMode: TCombineMode);
    23131538var
    23141539  PatternX, PatternY, X: Integer;
     
    23721597{ TSamplerFiller }
    23731598
     1599constructor TSamplerFiller.Create(Sampler: TCustomSampler = nil);
     1600begin
     1601  inherited Create;
     1602  FSampler := Sampler;
     1603  SamplerChanged;
     1604end;
     1605
     1606procedure TSamplerFiller.EndRendering;
     1607begin
     1608  if Assigned(FSampler) then
     1609    FSampler.FinalizeSampling
     1610  else
     1611    raise Exception.Create(RCStrNoSamplerSpecified);
     1612end;
     1613
    23741614procedure TSamplerFiller.SampleLineOpaque(Dst: PColor32; DstX, DstY,
    2375   Length: Integer; AlphaValues: PColor32);
     1615  Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
    23761616var
    23771617  X: Integer;
    23781618  BlendMemEx: TBlendMemEx;
    23791619begin
    2380   BlendMemEx := BLEND_MEM_EX[cmBlend]^;
     1620  BlendMemEx := BLEND_MEM_EX[CombineMode]^;
    23811621  for X := DstX to DstX + Length - 1 do
    23821622  begin
     
    23881628end;
    23891629
     1630procedure TSamplerFiller.SamplerChanged;
     1631begin
     1632  if Assigned(FSampler) then
     1633    FGetSample := FSampler.GetSampleInt;
     1634end;
     1635
     1636procedure TSamplerFiller.BeginRendering;
     1637begin
     1638  if Assigned(FSampler) then
     1639    FSampler.PrepareSampling
     1640  else
     1641    raise Exception.Create(RCStrNoSamplerSpecified);
     1642end;
     1643
    23901644function TSamplerFiller.GetFillLine: TFillLineEvent;
    23911645begin
     
    23951649procedure TSamplerFiller.SetSampler(const Value: TCustomSampler);
    23961650begin
    2397   FSampler := Value;
    2398   FGetSample := FSampler.GetSampleInt;
    2399 end;
     1651  if FSampler <> Value then
     1652  begin
     1653    FSampler := Value;
     1654    SamplerChanged;
     1655  end;
     1656end;
     1657
     1658
     1659{ TCustomPolygonRenderer }
     1660
     1661procedure TCustomPolygonRenderer.PolygonFS(
     1662  const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect;
     1663  Transformation: TTransformation);
     1664begin
     1665  PolyPolygonFS(PolyPolygon(Points), ClipRect, Transformation);
     1666end;
     1667
     1668procedure TCustomPolygonRenderer.PolygonFS(
     1669  const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect);
     1670begin
     1671  PolyPolygonFS(PolyPolygon(Points), ClipRect);
     1672end;
     1673
     1674procedure TCustomPolygonRenderer.PolyPolygonFS(
     1675  const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect);
     1676begin
     1677  // implemented by descendants
     1678end;
     1679
     1680procedure TCustomPolygonRenderer.PolyPolygonFS(
     1681  const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect;
     1682  Transformation: TTransformation);
     1683var
     1684  APoints: TArrayOfArrayOfFloatPoint;
     1685begin
     1686  if Assigned(Transformation) then
     1687    APoints := TransformPolyPolygon(Points, Transformation)
     1688  else
     1689    APoints := Points;
     1690  PolyPolygonFS(APoints, ClipRect);
     1691end;
     1692
     1693{ TPolygonRenderer32 }
     1694
     1695constructor TPolygonRenderer32.Create(Bitmap: TBitmap32;
     1696  Fillmode: TPolyFillMode);
     1697begin
     1698  inherited Create;
     1699  FBitmap := Bitmap;
     1700  FFillMode := Fillmode;
     1701end;
     1702
     1703procedure TPolygonRenderer32.PolygonFS(const Points: TArrayOfFloatPoint);
     1704begin
     1705  PolyPolygonFS(PolyPolygon(Points), FloatRect(FBitmap.ClipRect));
     1706end;
     1707
     1708procedure TPolygonRenderer32.PolyPolygonFS(const Points: TArrayOfArrayOfFloatPoint);
     1709begin
     1710  PolyPolygonFS(Points, FloatRect(FBitmap.ClipRect));
     1711end;
     1712
     1713procedure TPolygonRenderer32.SetBitmap(const Value: TBitmap32);
     1714begin
     1715  if FBitmap <> Value then
     1716  begin
     1717    FBitmap := Value;
     1718    Changed;
     1719  end;
     1720end;
     1721
     1722procedure TPolygonRenderer32.SetColor(const Value: TColor32);
     1723begin
     1724  if FColor <> Value then
     1725  begin
     1726    FColor := Value;
     1727    Changed;
     1728  end;
     1729end;
     1730
     1731procedure TPolygonRenderer32.SetFiller(const Value: TCustomPolygonFiller);
     1732begin
     1733  if FFiller <> Value then
     1734  begin
     1735    FFiller := Value;
     1736    Changed;
     1737  end;
     1738end;
     1739
     1740procedure TPolygonRenderer32.SetFillMode(const Value: TPolyFillMode);
     1741begin
     1742  if FFillMode <> Value then
     1743  begin
     1744    FFillMode := Value;
     1745    Changed;
     1746  end;
     1747end;
     1748
     1749{ TPolygonRenderer32VPR }
     1750
     1751{$IFDEF USESTACKALLOC}
     1752{$W+}
     1753{$ENDIF}
     1754procedure TPolygonRenderer32VPR.FillSpan(const Span: TValueSpan; DstY: Integer);
     1755var
     1756  AlphaValues: PColor32Array;
     1757  Count: Integer;
     1758begin
     1759  Count := Span.X2 - Span.X1 + 1;
     1760  {$IFDEF USESTACKALLOC}
     1761  AlphaValues := StackAlloc(Count * SizeOf(TColor32));
     1762  {$ELSE}
     1763  GetMem(AlphaValues, Count * SizeOf(TColor32));
     1764  {$ENDIF}
     1765  FFillProc(Span.Values, AlphaValues, Count, FColor);
     1766  FFiller.FillLine(@Bitmap.ScanLine[DstY][Span.X1], Span.X1, DstY, Count,
     1767    PColor32(AlphaValues), Bitmap.CombineMode);
     1768  EMMS;
     1769  {$IFDEF USESTACKALLOC}
     1770  StackFree(AlphaValues);
     1771  {$ELSE}
     1772  FreeMem(AlphaValues);
     1773  {$ENDIF}
     1774end;
     1775{$IFDEF USESTACKALLOC}
     1776{$W-}
     1777{$ENDIF}
     1778
     1779function TPolygonRenderer32VPR.GetRenderSpan: TRenderSpanEvent;
     1780begin
     1781  if Assigned(FFiller) then
     1782    Result := FillSpan
     1783  else
     1784    Result := RenderSpan;
     1785end;
     1786
     1787procedure TPolygonRenderer32VPR.PolyPolygonFS(
     1788  const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect);
     1789{$IFDEF CHANGENOTIFICATIONS}
     1790var
     1791  I: Integer;
     1792{$ENDIF}
     1793begin
     1794  UpdateFillProcs;
     1795  if Assigned(FFiller) then
     1796  begin
     1797    FFiller.BeginRendering;
     1798    RenderPolyPolygon(Points, ClipRect, GetRenderSpan());
     1799    FFiller.EndRendering;
     1800  end
     1801  else
     1802    RenderPolyPolygon(Points, ClipRect, GetRenderSpan());
     1803
     1804{$IFDEF CHANGENOTIFICATIONS}
     1805  if TBitmap32Access(Bitmap).UpdateCount = 0 then
     1806    for I := 0 to High(Points) do
     1807      if Length(Points[I]) > 0 then
     1808        Bitmap.Changed(MakeRect(PolygonBounds(Points[I])));
     1809{$ENDIF}
     1810end;
     1811
     1812{$W+}
     1813procedure TPolygonRenderer32VPR.RenderSpan(const Span: TValueSpan;
     1814  DstY: Integer);
     1815var
     1816  AlphaValues: PColor32Array;
     1817  Count: Integer;
     1818begin
     1819  Count := Span.X2 - Span.X1 + 1;
     1820  {$IFDEF USESTACKALLOC}
     1821  AlphaValues := StackAlloc(Count * SizeOf(TColor32));
     1822  {$ELSE}
     1823  GetMem(AlphaValues, Count * SizeOf(TColor32));
     1824  {$ENDIF}
     1825  FFillProc(Span.Values, AlphaValues, Count, FColor);
     1826  if Bitmap.CombineMode = cmMerge then
     1827    MergeLine(@AlphaValues[0], @Bitmap.ScanLine[DstY][Span.X1], Count)
     1828  else
     1829    BlendLine(@AlphaValues[0], @Bitmap.ScanLine[DstY][Span.X1], Count);
     1830  EMMS;
     1831  {$IFDEF USESTACKALLOC}
     1832  StackFree(AlphaValues);
     1833  {$ELSE}
     1834  FreeMem(AlphaValues);
     1835  {$ENDIF}
     1836end;
     1837{$W-}
     1838
     1839procedure TPolygonRenderer32VPR.UpdateFillProcs;
     1840const
     1841  FillProcs: array [Boolean, TPolyFillMode] of TFillProc = (
     1842    (MakeAlphaEvenOddUP, MakeAlphaNonZeroUP),
     1843    (MakeAlphaEvenOddUPF, MakeAlphaNonZeroUPF)
     1844  );
     1845begin
     1846  FFillProc := FillProcs[Assigned(FFiller), FillMode];
     1847end;
     1848
     1849{ TPolygonRenderer32LCD }
     1850
     1851procedure TPolygonRenderer32LCD.PolyPolygonFS(
     1852  const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect);
     1853var
     1854  R: TFloatRect;
     1855  APoints: TArrayOfArrayOfFloatPoint;
     1856{$IFDEF CHANGENOTIFICATIONS}
     1857  I: Integer;
     1858{$ENDIF}
     1859begin
     1860  APoints := ScalePolyPolygon(Points, 3, 1);
     1861  R.Top := ClipRect.Top;
     1862  R.Bottom := ClipRect.Bottom;
     1863  R.Left := ClipRect.Left * 3;
     1864  R.Right := ClipRect.Right * 3;
     1865  RenderPolyPolygon(APoints, R, RenderSpan);
     1866{$IFDEF CHANGENOTIFICATIONS}
     1867  if TBitmap32Access(Bitmap).UpdateCount = 0 then
     1868    for I := 0 to High(Points) do
     1869      if length(Points[I]) > 0 then
     1870        Bitmap.Changed(MakeRect(PolygonBounds(Points[I])));
     1871{$ENDIF}
     1872end;
     1873
     1874{$W+}
     1875procedure TPolygonRenderer32LCD.RenderSpan(const Span: TValueSpan;
     1876  DstY: Integer);
     1877const
     1878  PADDING = 5;
     1879var
     1880  AlphaValues: SysUtils.PByteArray;
     1881  Count: Integer;
     1882  X1, Offset: Integer;
     1883const
     1884  MakeAlpha: array [TPolyFillMode] of TMakeAlphaProcLCD = (MakeAlphaEvenOddLCD, MakeAlphaNonZeroLCD);
     1885begin
     1886  Count := Span.X2 - Span.X1 + 1;
     1887  X1 := DivMod(Span.X1, 3, Offset);
     1888
     1889  // Left Padding + Right Padding + Filter Width = 2 + 2 + 2 = 6
     1890  {$IFDEF USESTACKALLOC}
     1891  AlphaValues := StackAlloc((Count + 6 + PADDING) * SizeOf(Byte));
     1892  {$ELSE}
     1893  GetMem(AlphaValues, (Count + 6 + PADDING) * SizeOf(Byte));
     1894  {$ENDIF}
     1895  AlphaValues[0] := 0;
     1896  AlphaValues[1] := 0;
     1897  if (X1 > 0) then
     1898  begin
     1899    Dec(X1);
     1900    Inc(Offset, 3);
     1901    AlphaValues[2] := 0;
     1902    AlphaValues[3] := 0;
     1903    AlphaValues[4] := 0;
     1904  end;
     1905
     1906  MakeAlpha[FFillMode](Span.Values, PByteArray(@AlphaValues[PADDING]), Count, FColor);
     1907  CombineLineLCD(@AlphaValues[PADDING - Offset], PColor32Array(@Bitmap.ScanLine[DstY][X1]), FColor, (Count + Offset + 2) div 3);
     1908
     1909  {$IFDEF USESTACKALLOC}
     1910  StackFree(AlphaValues);
     1911  {$ELSE}
     1912  FreeMem(AlphaValues);
     1913  {$ENDIF}
     1914end;
     1915{$W-}
     1916
     1917
     1918{ TPolygonRenderer32LCD2 }
     1919
     1920{$W+}
     1921procedure TPolygonRenderer32LCD2.RenderSpan(const Span: TValueSpan;
     1922  DstY: Integer);
     1923const
     1924  PADDING = 5;
     1925var
     1926  AlphaValues: SysUtils.PByteArray;
     1927  Count: Integer;
     1928  X1, Offset: Integer;
     1929const
     1930  MakeAlpha: array [TPolyFillMode] of TMakeAlphaProcLCD = (MakeAlphaEvenOddLCD2, MakeAlphaNonZeroLCD2);
     1931begin
     1932  Count := Span.X2 - Span.X1 + 1;
     1933  X1 := DivMod(Span.X1, 3, Offset);
     1934
     1935  // Left Padding + Right Padding + Filter Width = 2 + 2 + 2 = 6
     1936  {$IFDEF USESTACKALLOC}
     1937  AlphaValues := StackAlloc((Count + 6 + PADDING) * SizeOf(Byte));
     1938  {$ELSE}
     1939  GetMem(AlphaValues, (Count + 6 + PADDING) * SizeOf(Byte));
     1940  {$ENDIF}
     1941  AlphaValues[0] := 0;
     1942  AlphaValues[1] := 0;
     1943  if (X1 > 0) then
     1944  begin
     1945    Dec(X1);
     1946    Inc(Offset, 3);
     1947    AlphaValues[2] := 0;
     1948    AlphaValues[3] := 0;
     1949    AlphaValues[4] := 0;
     1950  end;
     1951
     1952  Dec(Offset, 1);
     1953  MakeAlpha[FFillMode](Span.Values, PByteArray(@AlphaValues[PADDING]), Count, FColor);
     1954  Inc(Count);
     1955  CombineLineLCD(@AlphaValues[PADDING - Offset], PColor32Array(@Bitmap.ScanLine[DstY][X1]), FColor, (Count + Offset + 2) div 3);
     1956
     1957  {$IFDEF USESTACKALLOC}
     1958  StackFree(AlphaValues);
     1959  {$ELSE}
     1960  FreeMem(AlphaValues);
     1961  {$ENDIF}
     1962end;
     1963{$W-}
     1964
     1965initialization
     1966  RegisterPolygonRenderer(TPolygonRenderer32VPR);
     1967  RegisterPolygonRenderer(TPolygonRenderer32LCD);
     1968  RegisterPolygonRenderer(TPolygonRenderer32LCD2);
     1969
     1970finalization
     1971  PolygonRendererList.Free;
    24001972
    24011973end.
  • GraphicTest/Packages/Graphics32/GR32_RangeBars.pas

    r450 r522  
    7474    FOnUserChange: TNotifyEvent;
    7575    procedure SetButtonSize(Value: Integer);
    76     procedure SetBorderStyle(Value: TBorderStyle); {$IFDEF FPC} override; {$ENDIF}
    7776    procedure SetHandleColor(Value: TColor);
    7877    procedure SetHighLightColor(Value: TColor);
     
    101100{$ENDIF}
    102101  protected
    103     GenChange: Boolean;
    104     DragZone: TRBZone;
    105     HotZone: TRBZone;
    106     Timer: TTimer;
    107     TimerMode: Integer;
    108     StoredX, StoredY: Integer;
    109     PosBeforeDrag: Single;
     102    FGenChange: Boolean;
     103    FDragZone: TRBZone;
     104    FHotZone: TRBZone;
     105    FTimer: TTimer;
     106    FTimerMode: Integer;
     107    FStored: TPoint;
     108    FPosBeforeDrag: Single;
    110109    procedure DoChange; virtual;
    111110    procedure DoDrawButton(R: TRect; Direction: TRBDirection; Pushed, Enabled, Hot: Boolean); virtual;
     
    124123    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    125124    procedure Paint; override;
     125    procedure SetBorderStyle(Value: TBorderStyle); {$IFDEF FPC} override; {$ENDIF}
    126126    procedure StartDragTracking;
    127127    procedure StartHotTracking;
     
    632632begin
    633633  MouseLeft;
     634  inherited;
    634635end;
    635636
     
    642643  ParentColor := False;
    643644  Color := clScrollBar;
    644   Timer := TTimer.Create(Self);
    645   Timer.OnTimer := TimerHandler;
     645  FTimer := TTimer.Create(Self);
     646  FTimer.OnTimer := TimerHandler;
    646647  FShowArrows := True;
    647648  FBorderStyle := bsSingle;
     
    657658begin
    658659  if Assigned(FOnChange) then FOnChange(Self);
    659   if GenChange and Assigned(FOnUserChange) then FOnUserChange(Self);
     660  if FGenChange and Assigned(FOnUserChange) then FOnUserChange(Self);
    660661end;
    661662
     
    10211022  inherited;
    10221023  if Button <> mbLeft then Exit;
    1023   DragZone := GetZone(X, Y);
     1024  FDragZone := GetZone(X, Y);
    10241025  Invalidate;
    1025   StoredX := X;
    1026   StoredY := Y;
     1026  FStored.X := X;
     1027  FStored.Y := Y;
    10271028  StartDragTracking;
    10281029end;
     
    10381039begin
    10391040  inherited;
    1040   if (DragZone = zNone) and DrawEnabled then
     1041  if (FDragZone = zNone) and DrawEnabled then
    10411042  begin
    10421043    NewHotZone := GetZone(X, Y);
    1043     if NewHotZone <> HotZone then
    1044     begin
    1045       HotZone := NewHotZone;
    1046       if HotZone <> zNone then StartHotTracking;
     1044    if NewHotZone <> FHotZone then
     1045    begin
     1046      FHotZone := NewHotZone;
     1047      if FHotZone <> zNone then StartHotTracking;
    10471048      Invalidate;
    10481049    end;
     
    10531054begin
    10541055  inherited;
    1055   DragZone := zNone;
     1056  FDragZone := zNone;
    10561057  Invalidate;
    10571058  StopDragTracking;
     
    10781079    BtnRect := R;
    10791080    with BtnRect do if Horz then Right := Left + BSize else Bottom := Top + BSize;
    1080     DoDrawButton(BtnRect, CPrevDirs[Horz], DragZone = zBtnPrev, ShowEnabled, HotZone = zBtnPrev);
     1081    DoDrawButton(BtnRect, CPrevDirs[Horz], FDragZone = zBtnPrev, ShowEnabled, FHotZone = zBtnPrev);
    10811082
    10821083    { right / bottom button }
    10831084    BtnRect := R;
    10841085    with BtnRect do if Horz then Left := Right - BSize else Top := Bottom - BSize;
    1085     DoDrawButton(BtnRect, CNextDirs[Horz], DragZone = zBtnNext, ShowEnabled, HotZone = zBtnNext);
     1086    DoDrawButton(BtnRect, CNextDirs[Horz], FDragZone = zBtnNext, ShowEnabled, FHotZone = zBtnNext);
    10861087  end;
    10871088
     
    10911092  ShowHandle := not GR32.IsRectEmpty(HandleRect);
    10921093
    1093   DoDrawTrack(GetZoneRect(zTrackPrev), CPrevDirs[Horz], DragZone = zTrackPrev, ShowEnabled, HotZone = zTrackPrev);
    1094   DoDrawTrack(GetZoneRect(zTrackNext), CNextDirs[Horz], DragZone = zTrackNext, ShowEnabled, HotZone = zTrackNext);
    1095   if ShowHandle then DoDrawHandle(HandleRect, Horz, DragZone = zHandle, HotZone = zHandle);
     1094  DoDrawTrack(GetZoneRect(zTrackPrev), CPrevDirs[Horz], FDragZone = zTrackPrev, ShowEnabled, FHotZone = zTrackPrev);
     1095  DoDrawTrack(GetZoneRect(zTrackNext), CNextDirs[Horz], FDragZone = zTrackNext, ShowEnabled, FHotZone = zTrackNext);
     1096  if ShowHandle then DoDrawHandle(HandleRect, Horz, FDragZone = zHandle, FHotZone = zHandle);
    10961097end;
    10971098
     
    12191220procedure TArrowBar.StartDragTracking;
    12201221begin
    1221   Timer.Interval := FIRST_DELAY;
    1222   TimerMode := tmScroll;
     1222  FTimer.Interval := FIRST_DELAY;
     1223  FTimerMode := tmScroll;
    12231224  TimerHandler(Self);
    1224   TimerMode := tmScrollFirst;
    1225   Timer.Enabled := True;
     1225  FTimerMode := tmScrollFirst;
     1226  FTimer.Enabled := True;
    12261227end;
    12271228
    12281229procedure TArrowBar.StartHotTracking;
    12291230begin
    1230   Timer.Interval := HOTTRACK_INTERVAL;
    1231   TimerMode := tmHotTrack;
    1232   Timer.Enabled := True;
     1231  FTimer.Interval := HOTTRACK_INTERVAL;
     1232  FTimerMode := tmHotTrack;
     1233  FTimer.Enabled := True;
    12331234end;
    12341235
     
    12401241procedure TArrowBar.StopHotTracking;
    12411242begin
    1242   Timer.Enabled := False;
    1243   HotZone := zNone;
     1243  FTimer.Enabled := False;
     1244  FHotZone := zNone;
    12441245  Invalidate;
    12451246end;
     
    12491250  Pt: TPoint;
    12501251begin
    1251   case TimerMode of
     1252  case FTimerMode of
    12521253    tmScrollFirst:
    12531254      begin
    1254         Timer.Interval := SCROLL_INTERVAL;
    1255         TimerMode := tmScroll;
     1255        FTimer.Interval := SCROLL_INTERVAL;
     1256        FTimerMode := tmScroll;
    12561257      end;
    12571258    tmHotTrack:
     
    14311432  Shift: TShiftState; X, Y: Integer);
    14321433begin
    1433   if Range <= EffectiveWindow then DragZone := zNone
     1434  if Range <= EffectiveWindow then FDragZone := zNone
    14341435  else
    14351436  begin
    14361437    inherited;
    1437     if DragZone = zHandle then
     1438    if FDragZone = zHandle then
    14381439    begin
    14391440      StopDragTracking;
    1440       PosBeforeDrag := Position;
     1441      FPosBeforeDrag := Position;
    14411442    end;
    14421443  end;
     
    14501451begin
    14511452  inherited;
    1452   if DragZone = zHandle then
     1453  if FDragZone = zHandle then
    14531454  begin
    14541455    WinSz := EffectiveWindow;
    14551456
    14561457    if Range <= WinSz then Exit;
    1457     if Kind = sbHorizontal then Delta := X - StoredX else Delta := Y - StoredY;
     1458    if Kind = sbHorizontal then Delta := X - FStored.X else Delta := Y - FStored.Y;
    14581459
    14591460    if Kind = sbHorizontal then ClientSz := ClientWidth  else ClientSz := ClientHeight;
     
    14651466    else Delta := Delta * Range / ClientSz;
    14661467
    1467     GenChange := True;
    1468     Position := PosBeforeDrag + Delta;
    1469     GenChange := False;
     1468    FGenChange := True;
     1469    Position := FPosBeforeDrag + Delta;
     1470    FGenChange := False;
    14701471  end;
    14711472end;
     
    15611562begin
    15621563  inherited;
    1563   GenChange := True;
     1564  FGenChange := True;
    15641565  OldPosition := Position;
    15651566
    1566   case DragZone of
     1567  case FDragZone of
    15671568    zBtnPrev:
    15681569      begin
     
    15911592      end;
    15921593  end;
    1593   GenChange := False;
     1594  FGenChange := False;
    15941595end;
    15951596
     
    16771678begin
    16781679  inherited;
    1679   if DragZone = zHandle then
     1680  if FDragZone = zHandle then
    16801681  begin
    16811682    StopDragTracking;
    1682     PosBeforeDrag := Position;
     1683    FPosBeforeDrag := Position;
    16831684  end;
    16841685end;
     
    16911692begin
    16921693  inherited;
    1693   if DragZone = zHandle then
    1694   begin
    1695     if Kind = sbHorizontal then Delta := X - StoredX else Delta := Y - StoredY;
     1694  if FDragZone = zHandle then
     1695  begin
     1696    if Kind = sbHorizontal then Delta := X - FStored.X else Delta := Y - FStored.Y;
    16961697    R := GetTrackBoundary;
    16971698
     
    17011702    Delta := Delta * (Max - Min) / (ClientSz - GetHandleSize);
    17021703
    1703     GenChange := True;
    1704     Position := Round(PosBeforeDrag + Delta);
    1705     GenChange := False;
     1704    FGenChange := True;
     1705    Position := Round(FPosBeforeDrag + Delta);
     1706    FGenChange := False;
    17061707  end;
    17071708end;
     
    17791780begin
    17801781  inherited;
    1781   GenChange := True;
     1782  FGenChange := True;
    17821783  OldPosition := Position;
    17831784
    1784   case DragZone of
     1785  case FDragZone of
    17851786    zBtnPrev:
    17861787      begin
     
    18091810      end;
    18101811  end;
    1811   GenChange := False;
     1812  FGenChange := False;
    18121813end;
    18131814
  • GraphicTest/Packages/Graphics32/GR32_Rasterizers.pas

    r450 r522  
    4747  Windows,
    4848{$ENDIF}
    49   Classes, GR32, GR32_Blend, GR32_OrdinalMaps;
     49  Classes, GR32, GR32_Blend;
    5050
    5151type
     
    184184
    185185uses
    186   GR32_Resamplers, GR32_Containers, GR32_System, Math, GR32_Math, SysUtils;
     186  Math, SysUtils, GR32_Math, GR32_System, GR32_LowLevel, GR32_Resamplers,
     187  GR32_Containers, GR32_OrdinalMaps;
    187188
    188189type
    189   TThreadPersistentAccess = class(TThreadPersistent);
     190  TCustomBitmap32Access = class(TCustomBitmap32);
    190191
    191192  TLineRasterizerData = record
     
    292293  R: TRect;
    293294begin
    294   UpdateCount := TThreadPersistentAccess(Dst).UpdateCount;
     295  UpdateCount := TCustomBitmap32Access(Dst).UpdateCount;
    295296  if Assigned(FSampler) then
    296297  begin
     
    302303      DoRasterize(Dst, R);
    303304    finally
    304       while TThreadPersistentAccess(Dst).UpdateCount > UpdateCount do
    305         TThreadPersistentAccess(Dst).EndUpdate;
     305      while TCustomBitmap32Access(Dst).UpdateCount > UpdateCount do
     306        TCustomBitmap32Access(Dst).EndUpdate;
    306307      FSampler.FinalizeSampling;
    307308    end;
     
    430431  Size := NextPowerOf2(Max(W, H));
    431432
    432   SetLength(ForwardBuffer, Size);
     433  SetLength(ForwardBuffer, Size + 1);
    433434
    434435  I := 2;
    435   while I < Size do
     436  while I <= Size do
    436437  begin
    437438    ForwardBuffer[I] := ForwardBuffer[I shr 1] + 1;
     
    452453    P2.X := L + P1.X;
    453454    P2.Y := T + P1.Y;
     455
    454456    AssignColor(Dst.Bits[P2.X + P2.Y * RowSize], GetSample(P2.X, P2.Y));
    455457
     
    482484  FUpdateRows := True;
    483485end;
     486
     487{$DEFINE UseInternalFill}
    484488
    485489procedure TProgressiveRasterizer.DoRasterize(Dst: TCustomBitmap32;
     
    491495  Step: Integer;
    492496  GetSample: TGetSampleInt;
    493 begin
    494     GetSample := FSampler.GetSampleInt;
    495     OnChanged := Dst.OnAreaChanged;
    496     DoUpdate := (TThreadPersistentAccess(Dst).UpdateCount = 0) and Assigned(OnChanged);
    497     W := DstRect.Right - DstRect.Left;
    498     H := DstRect.Bottom - DstRect.Top;
    499     J := DstRect.Top;
    500     Step := 1 shl FSteps;
    501     while J < DstRect.Bottom do
    502     begin
    503       I := DstRect.Left;
    504       B := Min(J + Step, DstRect.Bottom);
    505       while I < DstRect.Right - Step do
    506       begin
    507         Dst.FillRect(I, J, I + Step, B, GetSample(I, J));
    508         Inc(I, Step);
    509       end;
    510       Dst.FillRect(I, J, DstRect.Right, B, GetSample(I, J));
    511       if DoUpdate and FUpdateRows then
    512         OnChanged(Dst, Rect(DstRect.Left, J, DstRect.Right, B), AREAINFO_RECT);
    513       Inc(J, Step);
    514     end;
    515     if DoUpdate and (not FUpdateRows) then OnChanged(Dst, DstRect, AREAINFO_RECT);
    516 
    517     Shift := FSteps;
    518     while Step > 1 do
    519     begin
    520       Dec(Shift);
    521       Step := Step div 2;
    522       Wk := W div Step - 1;
    523       Hk := H div Step;
    524       for J := 0 to Hk do
    525       begin
    526         Y := DstRect.Top + J shl Shift;
    527         B := Min(Y + Step, DstRect.Bottom);
    528         if Odd(J) then
    529           for I := 0 to Wk do
     497
     498{$IFDEF UseInternalFill}
     499  Bits: PColor32Array;
     500
     501procedure IntFillRect(X1, Y1, X2, Y2: Integer; C: TColor32);
     502var
     503  Y: Integer;
     504  P: PColor32Array;
     505begin
     506  for Y := Y1 to Y2 - 1 do
     507  begin
     508    P := Pointer(@Bits[Y * W]);
     509    FillLongword(P[X1], X2 - X1, C);
     510  end;
     511end;
     512{$ENDIF}
     513
     514begin
     515  GetSample := FSampler.GetSampleInt;
     516  OnChanged := Dst.OnAreaChanged;
     517{$IFDEF UseInternalFill}
     518  Bits := Dst.Bits;
     519{$ENDIF}
     520  DoUpdate := (TCustomBitmap32Access(Dst).UpdateCount = 0) and Assigned(OnChanged);
     521  W := DstRect.Right - DstRect.Left;
     522  H := DstRect.Bottom - DstRect.Top;
     523  J := DstRect.Top;
     524  Step := 1 shl FSteps;
     525  while J < DstRect.Bottom do
     526  begin
     527    I := DstRect.Left;
     528    B := Min(J + Step, DstRect.Bottom);
     529    while I < DstRect.Right - Step do
     530    begin
     531      {$IFDEF UseInternalFill}
     532      IntFillRect(I, J, I + Step, B, GetSample(I, J));
     533      {$ELSE}
     534      Dst.FillRect(I, J, I + Step, B, GetSample(I, J));
     535      {$ENDIF}
     536      Inc(I, Step);
     537    end;
     538    {$IFDEF UseInternalFill}
     539    IntFillRect(I, J, DstRect.Right, B, GetSample(I, J));
     540    if DoUpdate and FUpdateRows then
     541      OnChanged(Dst, Rect(DstRect.Left, J, DstRect.Right, B), AREAINFO_RECT);
     542    {$ELSE}
     543    Dst.FillRect(I, J, DstRect.Right, B, GetSample(I, J));
     544    {$ENDIF}
     545    Inc(J, Step);
     546  end;
     547  if DoUpdate and (not FUpdateRows) then OnChanged(Dst, DstRect, AREAINFO_RECT);
     548
     549  Shift := FSteps;
     550  while Step > 1 do
     551  begin
     552    Dec(Shift);
     553    Step := Step div 2;
     554    Wk := W div Step - 1;
     555    Hk := H div Step;
     556    for J := 0 to Hk do
     557    begin
     558      Y := DstRect.Top + J shl Shift;
     559      B := Min(Y + Step, DstRect.Bottom);
     560      if Odd(J) then
     561        for I := 0 to Wk do
     562        begin
     563          X := DstRect.Left + I shl Shift;
     564          {$IFDEF UseInternalFill}
     565          IntFillRect(X, Y, X + Step, B, GetSample(X, Y));
     566          {$ELSE}
     567          Dst.FillRect(X, Y, X + Step, B, GetSample(X, Y));
     568          {$ENDIF}
     569        end
     570      else
     571        for I := 0 to Wk do
     572          if Odd(I) then
    530573          begin
    531574            X := DstRect.Left + I shl Shift;
     575            {$IFDEF UseInternalFill}
     576            IntFillRect(X, Y, X + Step, B, GetSample(X, Y));
     577            {$ELSE}
    532578            Dst.FillRect(X, Y, X + Step, B, GetSample(X, Y));
    533           end
    534         else
    535           for I := 0 to Wk do
    536             if Odd(I) then
    537             begin
    538               X := DstRect.Left + I shl Shift;
    539               Dst.FillRect(X, Y, X + Step, B, GetSample(X, Y));
    540             end;
    541         X := DstRect.Left + Wk shl Shift;
    542         Dst.FillRect(X, Y, DstRect.Right, B, GetSample(X, Y));
    543         if FUpdateRows and DoUpdate then
    544           OnChanged(Dst, Rect(DstRect.Left, Y, DstRect.Right, B), AREAINFO_RECT);
    545       end;
    546       if DoUpdate and (not FUpdateRows) then OnChanged(Dst, DstRect, AREAINFO_RECT);
    547     end;
     579            {$ENDIF}
     580          end;
     581      X := DstRect.Left + Wk shl Shift;
     582      {$IFDEF UseInternalFill}
     583      IntFillRect(X, Y, DstRect.Right, B, GetSample(X, Y));
     584      if FUpdateRows and DoUpdate then
     585        OnChanged(Dst, Rect(DstRect.Left, Y, DstRect.Right, B), AREAINFO_RECT);
     586      {$ELSE}
     587      Dst.FillRect(X, Y, DstRect.Right, B, GetSample(X, Y));
     588      {$ENDIF}
     589    end;
     590    if DoUpdate and (not FUpdateRows) then OnChanged(Dst, DstRect, AREAINFO_RECT);
     591  end;
    548592end;
    549593
  • GraphicTest/Packages/Graphics32/GR32_Reg.pas

    r450 r522  
    6060  GR32_Layers,
    6161  GR32_RangeBars,
     62  GR32_ColorPicker,
     63  GR32_ColorSwatch,
    6264  GR32_Resamplers;
    6365
     
    6668begin
    6769  RegisterComponents('Graphics32', [TPaintBox32, TImage32, TBitmap32List,
    68     TRangeBar, TGaugeBar, TImgView32{$IFDEF Windows}, TSyntheticImage32{$ENDIF}]);
     70    TRangeBar, TGaugeBar, TImgView32{$IFDEF Windows}, TSyntheticImage32{$ENDIF},
     71    TColorPickerComponent, TColorPickerRGBA, TColorPickerHS, TColorPickerHSV,
     72    TColorPickerGTK, {$IFDEF COMPILER2010_UP} TColor32Dialog,{$ENDIF}
     73    TColorSwatch]);
    6974  RegisterPropertyEditor(TypeInfo(TColor32), nil, '', TColor32Property);
    7075  RegisterPropertyEditor(TypeInfo(TBitmap32), nil, '', TBitmap32Property);
     
    8388
    8489end.
     90
  • GraphicTest/Packages/Graphics32/GR32_RepaintOpt.pas

    r450 r522  
    4242  LCLIntf,
    4343{$ELSE}
    44   Windows,
     44  Types, Windows,
    4545{$ENDIF}
    46   Classes, SysUtils, GR32, GR32_LowLevel, GR32_Containers, GR32_Layers;
     46  Classes, SysUtils, GR32, GR32_Containers, GR32_Layers;
    4747
    4848type
  • GraphicTest/Packages/Graphics32/GR32_Resamplers.pas

    r450 r522  
    5050{$ENDIF}
    5151  Classes, SysUtils, GR32, GR32_Transforms, GR32_Containers,
    52   GR32_OrdinalMaps, GR32_Blend, GR32_System, GR32_Bindings;
     52  GR32_OrdinalMaps, GR32_Blend;
    5353
    5454procedure BlockTransfer(
     
    343343    procedure SetKernel(const Value: TCustomKernel);
    344344    function GetKernelClassName: string;
    345     procedure SetKernelClassName(Value: string);
     345    procedure SetKernelClassName(const Value: string);
    346346    procedure SetKernelMode(const Value: TKernelMode);
    347347    procedure SetTableSize(Value: Integer);
     
    578578procedure IncBuffer(var Buffer: TBufferEntry; Color: TColor32); {$IFDEF USEINLINING} inline; {$ENDIF}
    579579procedure MultiplyBuffer(var Buffer: TBufferEntry; W: Integer); {$IFDEF USEINLINING} inline; {$ENDIF}
    580 function BufferToColor32(Buffer: TBufferEntry; Shift: Integer): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
     580function BufferToColor32(const Buffer: TBufferEntry; Shift: Integer): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
    581581procedure ShrBuffer(var Buffer: TBufferEntry; Shift: Integer); {$IFDEF USEINLINING} inline; {$ENDIF}
     582
     583{ Downsample byte map }
     584procedure DownsampleByteMap2x(Source, Dest: TByteMap);
     585procedure DownsampleByteMap3x(Source, Dest: TByteMap);
     586procedure DownsampleByteMap4x(Source, Dest: TByteMap);
    582587
    583588{ Registration routines }
     
    605610
    606611uses
    607   GR32_LowLevel, GR32_Rasterizers, GR32_Math, Math;
     612  GR32_System, GR32_Bindings, GR32_LowLevel, GR32_Rasterizers, GR32_Math,
     613  GR32_Gamma, Math;
    608614
    609615resourcestring
     
    611617
    612618const
    613   CAlbrecht2    : array [0..1] of Double = (5.383553946707251E-1, 4.616446053292749E-1);
    614   CAlbrecht3    : array [0..2] of Double = (3.46100822018625E-1,  4.97340635096738E-1,
    615                                             1.56558542884637E-1);
    616   CAlbrecht4    : array [0..3] of Double = (2.26982412792069E-1,  4.57254070828427E-1,
    617                                             2.73199027957384E-1,  4.25644884221201E-2);
    618   CAlbrecht5    : array [0..4] of Double = (1.48942606015830E-1,  3.86001173639176E-1,
    619                                             3.40977403214053E-1,  1.139879604246E-1,
    620                                             1.00908567063414E-2);
    621   CAlbrecht6    : array [0..5] of Double = (9.71676200107429E-2,  3.08845222524055E-1,
    622                                             3.62623371437917E-1,  1.88953325525116E-1,
    623                                             4.02095714148751E-2,  2.20088908729420E-3);
    624   CAlbrecht7    : array [0..6] of Double = (6.39644241143904E-2,  2.39938645993528E-1,
    625                                             3.50159563238205E-1,  2.47741118970808E-1,
    626                                             8.54382560558580E-2,  1.23202033692932E-2,
    627                                             4.37788257917735E-4);
    628   CAlbrecht8    : array [0..7] of Double = (4.21072107042137E-2,  1.82076226633776E-1,
    629                                             3.17713781059942E-1,  2.84438001373442E-1,
    630                                             1.36762237777383E-1,  3.34038053504025E-2,
    631                                             3.41677216705768E-3,  8.19649337831348E-5);
    632   CAlbrecht9    : array [0..8] of Double = (2.76143731612611E-2,  1.35382228758844E-1,
    633                                             2.75287234472237E-1,  2.98843335317801E-1,
    634                                             1.85319330279284E-1,  6.48884482549063E-2,
    635                                             1.17641910285655E-2,  8.85987580106899E-4,
    636                                             1.48711469943406E-5);
    637   CAlbrecht10   : array [0..9] of Double = (1.79908225352538E-2,  9.87959586065210E-2,
    638                                             2.29883817001211E-1,  2.94113019095183E-1,
    639                                             2.24338977814325E-1,  1.03248806248099E-1,
    640                                             2.75674109448523E-2,  3.83958622947123E-3,
    641                                             2.18971708430106E-4,  2.62981665347889E-6);
    642   CAlbrecht11  : array [0..10] of Double = (1.18717127796602E-2,  7.19533651951142E-2,
    643                                             1.87887160922585E-1,  2.75808174097291E-1,
    644                                             2.48904243244464E-1,  1.41729867200712E-1,
    645                                             5.02002976228256E-2,  1.04589649084984E-2,
    646                                             1.13615112741660E-3,  4.96285981703436E-5,
    647                                             4.34303262685720E-7);
     619  CAlbrecht2 : array [0..1] of Double = (5.383553946707251E-1,
     620    4.616446053292749E-1);
     621  CAlbrecht3 : array [0..2] of Double = (3.46100822018625E-1,
     622    4.97340635096738E-1, 1.56558542884637E-1);
     623  CAlbrecht4 : array [0..3] of Double = (2.26982412792069E-1,
     624    4.57254070828427E-1, 2.73199027957384E-1, 4.25644884221201E-2);
     625  CAlbrecht5 : array [0..4] of Double = (1.48942606015830E-1,
     626    3.86001173639176E-1, 3.40977403214053E-1, 1.139879604246E-1,
     627    1.00908567063414E-2);
     628  CAlbrecht6 : array [0..5] of Double = (9.71676200107429E-2,
     629    3.08845222524055E-1, 3.62623371437917E-1, 1.88953325525116E-1,
     630    4.02095714148751E-2, 2.20088908729420E-3);
     631  CAlbrecht7 : array [0..6] of Double = (6.39644241143904E-2,
     632    2.39938645993528E-1, 3.50159563238205E-1, 2.47741118970808E-1,
     633    8.54382560558580E-2, 1.23202033692932E-2, 4.37788257917735E-4);
     634  CAlbrecht8 : array [0..7] of Double = (4.21072107042137E-2,
     635    1.82076226633776E-1, 3.17713781059942E-1, 2.84438001373442E-1,
     636    1.36762237777383E-1, 3.34038053504025E-2, 3.41677216705768E-3,
     637    8.19649337831348E-5);
     638  CAlbrecht9 : array [0..8] of Double = (2.76143731612611E-2,
     639    1.35382228758844E-1, 2.75287234472237E-1, 2.98843335317801E-1,
     640    1.85319330279284E-1, 6.48884482549063E-2, 1.17641910285655E-2,
     641    8.85987580106899E-4, 1.48711469943406E-5);
     642  CAlbrecht10: array [0..9] of Double = (1.79908225352538E-2,
     643    9.87959586065210E-2, 2.29883817001211E-1, 2.94113019095183E-1,
     644    2.24338977814325E-1, 1.03248806248099E-1, 2.75674109448523E-2,
     645    3.83958622947123E-3, 2.18971708430106E-4, 2.62981665347889E-6);
     646  CAlbrecht11: array [0..10] of Double = (1.18717127796602E-2,
     647    7.19533651951142E-2, 1.87887160922585E-1, 2.75808174097291E-1,
     648    2.48904243244464E-1, 1.41729867200712E-1, 5.02002976228256E-2,
     649    1.04589649084984E-2, 1.13615112741660E-3, 4.96285981703436E-5,
     650    4.34303262685720E-7);
     651
    648652type
    649653  TTransformationAccess = class(TTransformation);
     
    660664  TMappingTable = array of TCluster;
    661665
    662 
    663 type
    664666  TKernelSamplerClass = class of TKernelSampler;
    665667
     
    741743end;
    742744
    743 function BufferToColor32(Buffer: TBufferEntry; Shift: Integer): TColor32;
     745function BufferToColor32(const Buffer: TBufferEntry; Shift: Integer): TColor32;
    744746begin
    745747  with TColor32Entry(Result) do
     
    17191721          C := Src.Bits[X + ClusterY[Y].Pos * Src.Width];
    17201722          ClustYW := ClusterY[Y].Weight;
    1721           Inc(Ca, C shr 24 * ClustYW);
    1722           Inc(Cr, (C and $00FF0000) shr 16 * ClustYW);
    1723           Inc(Cg, (C and $0000FF00) shr 8 * ClustYW);
    1724           Inc(Cb, (C and $000000FF) * ClustYW);
     1723          Inc(Ca, Integer(C shr 24) * ClustYW);
     1724          Inc(Cr, Integer(C and $00FF0000) shr 16 * ClustYW);
     1725          Inc(Cg, Integer(C and $0000FF00) shr 8 * ClustYW);
     1726          Inc(Cb, Integer(C and $000000FF) * ClustYW);
    17251727        end;
    17261728        with HorzBuffer[X - MapXLoPos] do
     
    18121814    Inc(NativeUInt(RowSrc), OffSrc);
    18131815    {$ELSE}
    1814     Inc(Cardinal(RowSrc), OffSrc);
     1816    Inc(PByte(RowSrc), OffSrc);
    18151817    {$ENDIF}
    18161818  end;
     
    22942296        Inc(NativeUInt(RowSrc), OffSrc * dy);
    22952297        {$ELSE}
    2296         Inc(Cardinal(RowSrc), OffSrc * dy);
     2298        Inc(PByte(RowSrc), OffSrc * dy);
    22972299        {$ENDIF}
    22982300      end;
     
    24912493
    24922494
     2495{ TByteMap downsample functions }
     2496
     2497procedure DownsampleByteMap2x(Source, Dest: TByteMap);
     2498var
     2499  X, Y: Integer;
     2500  ScnLn: array [0 .. 2] of PByteArray;
     2501begin
     2502  for Y := 0 to (Source.Height div 2) - 1 do
     2503  begin
     2504    ScnLn[0] := Dest.ScanLine[Y];
     2505    ScnLn[1] := Source.ScanLine[Y * 2];
     2506    ScnLn[2] := Source.ScanLine[Y * 2 + 1];
     2507    for X := 0 to (Source.Width div 2) - 1 do
     2508      ScnLn[0, X] := (
     2509        ScnLn[1, 2 * X] + ScnLn[1, 2 * X + 1] +
     2510        ScnLn[2, 2 * X] + ScnLn[2, 2 * X + 1]) div 4;
     2511  end;
     2512end;
     2513
     2514procedure DownsampleByteMap3x(Source, Dest: TByteMap);
     2515var
     2516  X, Y: Integer;
     2517  x3: Integer;
     2518  ScnLn: array [0 .. 3] of PByteArray;
     2519begin
     2520  for Y := 0 to (Source.Height div 3) - 1 do
     2521  begin
     2522    ScnLn[0] := Dest.ScanLine[Y];
     2523    ScnLn[1] := Source.ScanLine[3 * Y];
     2524    ScnLn[2] := Source.ScanLine[3 * Y + 1];
     2525    ScnLn[3] := Source.ScanLine[3 * Y + 2];
     2526    for X := 0 to (Source.Width div 3) - 1 do
     2527    begin
     2528      x3 := 3 * X;
     2529      ScnLn[0, X] := (
     2530        ScnLn[1, x3] + ScnLn[1, x3 + 1] + ScnLn[1, x3 + 2] +
     2531        ScnLn[2, x3] + ScnLn[2, x3 + 1] + ScnLn[2, x3 + 2] +
     2532        ScnLn[3, x3] + ScnLn[3, x3 + 1] + ScnLn[3, x3 + 2]) div 9;
     2533    end;
     2534  end;
     2535end;
     2536
     2537procedure DownsampleByteMap4x(Source, Dest: TByteMap);
     2538var
     2539  X, Y: Integer;
     2540  x4: Integer;
     2541  ScnLn: array [0 .. 4] of PByteArray;
     2542begin
     2543  for Y := 0 to (Source.Height div 4) - 1 do
     2544  begin
     2545    ScnLn[0] := Dest.ScanLine[Y];
     2546    ScnLn[1] := Source.ScanLine[Y * 4];
     2547    ScnLn[2] := Source.ScanLine[Y * 4 + 1];
     2548    ScnLn[3] := Source.ScanLine[Y * 4 + 2];
     2549    ScnLn[4] := Source.ScanLine[Y * 4 + 3];
     2550    for X := 0 to (Source.Width div 4) - 1 do
     2551    begin
     2552      x4 := 4 * X;
     2553      ScnLn[0, X] := (
     2554        ScnLn[1, x4] + ScnLn[1, x4 + 1] + ScnLn[1, x4 + 2] + ScnLn[1, x4 + 3] +
     2555        ScnLn[2, x4] + ScnLn[2, x4 + 1] + ScnLn[2, x4 + 2] + ScnLn[2, x4 + 3] +
     2556        ScnLn[3, x4] + ScnLn[3, x4 + 1] + ScnLn[3, x4 + 2] + ScnLn[3, x4 + 3] +
     2557        ScnLn[4, x4] + ScnLn[4, x4 + 1] + ScnLn[4, x4 + 2] + ScnLn[4, x4 + 3]) div 16;
     2558    end;
     2559  end;
     2560end;
     2561
    24932562
    24942563{ TCustomKernel }
     
    29353004end;
    29363005
    2937 procedure TKernelResampler.SetKernelClassName(Value: string);
     3006procedure TKernelResampler.SetKernelClassName(const Value: string);
    29383007var
    29393008  KernelClass: TCustomKernelClass;
     
    31733242                end else
    31743243                begin
    3175                   Inc(HorzEntry.R, Div255(Alpha * SrcP.R) * W);
    3176                   Inc(HorzEntry.G, Div255(Alpha * SrcP.G) * W);
    3177                   Inc(HorzEntry.B, Div255(Alpha * SrcP.B) * W);
     3244                  Inc(HorzEntry.R, Integer(Div255(Alpha * SrcP.R)) * W);
     3245                  Inc(HorzEntry.G, Integer(Div255(Alpha * SrcP.G)) * W);
     3246                  Inc(HorzEntry.B, Integer(Div255(Alpha * SrcP.B)) * W);
    31783247                end;
    31793248              end;
     
    31963265          begin
    31973266            // Sample premultiplied values
    3198             OuterPremultColorR := Div255(Alpha * TColor32Entry(FOuterColor).R);
    3199             OuterPremultColorG := Div255(Alpha * TColor32Entry(FOuterColor).G);
    3200             OuterPremultColorB := Div255(Alpha * TColor32Entry(FOuterColor).B);
     3267            OuterPremultColorR := Integer(Div255(Alpha * TColor32Entry(FOuterColor).R));
     3268            OuterPremultColorG := Integer(Div255(Alpha * TColor32Entry(FOuterColor).G));
     3269            OuterPremultColorB := Integer(Div255(Alpha * TColor32Entry(FOuterColor).B));
    32013270
    32023271            for I := -KWidth to KWidth do
     
    33643433  if FKernelMode in [kmTableNearest, kmTableLinear] then
    33653434  begin
    3366     FWeightTable := TIntegerMap.Create;
    3367     FWeightTable.SetSize(W * 2 + 1, FTableSize + 1);
     3435    FWeightTable := TIntegerMap.Create(W * 2 + 1, FTableSize + 1);
    33683436    for I := 0 to FTableSize do
    33693437    begin
     
    33823450end;
    33833451
     3452
    33843453{ TCustomBitmap32NearestResampler }
    33853454
     
    35183587      end;
    35193588
    3520       WX := GAMMA_TABLE[((X shr 8) and $FF) xor $FF];
     3589      WX := GAMMA_ENCODING_TABLE[((X shr 8) and $FF) xor $FF];
    35213590      Result := CombineReg(CombineReg(C1, C2, WX),
    35223591                           CombineReg(C3, C4, WX),
    3523                            GAMMA_TABLE[((Y shr 8) and $FF) xor $FF]);
     3592                           GAMMA_ENCODING_TABLE[((Y shr 8) and $FF) xor $FF]);
    35243593      EMMS; 
    35253594    end 
     
    35583627  DstH := DstRect.Bottom - DstRect.Top;
    35593628  if (DstW > SrcW) and (DstH > SrcH) and (SrcW > 1) and (SrcH > 1) then
    3560     StretchHorzStretchVertLinear(Dst, DstRect, DstClip, Src, SrcRect, CombineOp, CombineCallBack)
     3629    StretchHorzStretchVertLinear(Dst, DstRect, DstClip, Src, SrcRect, CombineOp,
     3630      CombineCallBack)
    35613631  else
    3562     GR32_Resamplers.Resample(Dst, DstRect, DstClip, Src, SrcRect, FLinearKernel, CombineOp, CombineCallBack);
     3632    GR32_Resamplers.Resample(Dst, DstRect, DstClip, Src, SrcRect, FLinearKernel,
     3633      CombineOp, CombineCallBack);
    35633634end;
    35643635
     
    35683639  CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent);
    35693640begin
    3570   DraftResample(Dst, DstRect, DstClip, Src, SrcRect, FLinearKernel, CombineOp, CombineCallBack)
     3641  DraftResample(Dst, DstRect, DstClip, Src, SrcRect, FLinearKernel, CombineOp,
     3642    CombineCallBack)
    35713643end;
    35723644
     
    35773649  U, V: TFixed;
    35783650begin
    3579   FTransformationReverseTransformFixed(X * FixedOne + FixedHalf, Y * FixedOne + FixedHalf, U, V);
     3651  FTransformationReverseTransformFixed(X * FixedOne + FixedHalf,
     3652    Y * FixedOne + FixedHalf, U, V);
    35803653  Result := FGetSampleFixed(U - FixedHalf, V - FixedHalf);
    35813654end;
     
    41394212end;
    41404213
    4141 {CPU target and feature Function templates}
     4214{CPU target and feature function templates}
    41424215
    41434216const
  • GraphicTest/Packages/Graphics32/GR32_System.pas

    r450 r522  
    7070    function ReadNanoseconds: string;
    7171    function ReadMilliseconds: string;
    72     function ReadSeconds: String;
     72    function ReadSeconds: string;
     73
    7374    function ReadValue: Int64;
    7475  end;
     
    127128
    128129function TPerfTimer.ReadNanoseconds: string;
    129 var
    130   t : timeval;
    131 begin
    132   fpgettimeofday(@t,nil);
    133    // Build a 64 bit microsecond tick from the seconds and microsecond longints
    134   Result := IntToStr( ( (Int64(t.tv_sec) * 1000000) + t.tv_usec ) div 1000 );
     130begin
     131  Result := IntToStr(ReadValue);
    135132end;
    136133
    137134function TPerfTimer.ReadMilliseconds: string;
    138 var
    139   t : timeval;
    140 begin
    141   fpgettimeofday(@t,nil);
    142    // Build a 64 bit microsecond tick from the seconds and microsecond longints
    143   Result := IntToStr( ( (Int64(t.tv_sec) * 1000000) + t.tv_usec ) * 1000 );
     135begin
     136  Result := IntToStr(ReadValue div 1000);
    144137end;
    145138
    146139function TPerfTimer.ReadSeconds: string;
    147 var
    148   t : timeval;
    149 begin
    150   fpgettimeofday(@t,nil);
    151    // Build a 64 bit microsecond tick from the seconds and microsecond longints
    152   Result := IntToStr( ( (Int64(t.tv_sec) * 1000000) + t.tv_usec ) );
     140begin
     141  Result := IntToStr(ReadValue div 1000000);
    153142end;
    154143
    155144function TPerfTimer.ReadValue: Int64;
    156 var t : timeval;
    157 begin
    158   fpgettimeofday(@t,nil);
    159    // Build a 64 bit microsecond tick from the seconds and microsecond longints
    160   Result := (Int64(t.tv_sec) * 1000000) + t.tv_usec;
    161   Result := Result div 1000;
     145begin
     146  Result := GetTickCount - FStart;
    162147end;
    163148
    164149procedure TPerfTimer.Start;
    165 var
    166   t : timeval;
    167 begin
    168   fpgettimeofday(@t,nil);
    169    // Build a 64 bit microsecond tick from the seconds and microsecond longints
    170   FStart := (Int64(t.tv_sec) * 1000000) + t.tv_usec;
     150begin
     151  FStart := GetTickCount;
    171152end;
    172153{$ENDIF}
     
    242223{$IFNDEF PUREPASCAL}
    243224const
    244   CPUISChecks: Array[TCPUInstructionSet] of Cardinal =
     225  CPUISChecks: array [TCPUInstructionSet] of Cardinal =
    245226    ($800000,  $400000, $2000000, $4000000, $80000000, $40000000);
    246227    {ciMMX  ,  ciEMMX,  ciSSE   , ciSSE2  , ci3DNow ,  ci3DNowExt}
     
    248229function CPUID_Available: Boolean;
    249230asm
     231{$IFDEF TARGET_x86}
     232        MOV       EDX,False
     233        PUSHFD
     234        POP       EAX
     235        MOV       ECX,EAX
     236        XOR       EAX,$00200000
     237        PUSH      EAX
     238        POPFD
     239        PUSHFD
     240        POP       EAX
     241        XOR       ECX,EAX
     242        JZ        @1
     243        MOV       EDX,True
     244@1:     PUSH      EAX
     245        POPFD
     246        MOV       EAX,EDX
     247{$ENDIF}
    250248{$IFDEF TARGET_x64}
    251249        MOV       EDX,False
     
    264262        POPFQ
    265263        MOV       EAX,EDX
    266 {$ELSE}
    267         MOV       EDX,False
    268         PUSHFD
    269         POP       EAX
    270         MOV       ECX,EAX
    271         XOR       EAX,$00200000
    272         PUSH      EAX
    273         POPFD
    274         PUSHFD
    275         POP       EAX
    276         XOR       ECX,EAX
    277         JZ        @1
    278         MOV       EDX,True
    279 @1:     PUSH      EAX
    280         POPFD
    281         MOV       EAX,EDX
    282264{$ENDIF}
    283265end;
     
    285267function CPU_Signature: Integer;
    286268asm
    287 {$IFDEF TARGET_x64}
    288         PUSH      RBX
    289         MOV       EAX,1
    290         CPUID
    291         POP       RBX
    292 {$ELSE}
     269{$IFDEF TARGET_x86}
    293270        PUSH      EBX
    294271        MOV       EAX,1
     
    300277        POP       EBX
    301278{$ENDIF}
    302 end;
    303 
    304 function CPU_Features: Integer;
    305 asm
    306279{$IFDEF TARGET_x64}
    307280        PUSH      RBX
     
    309282        CPUID
    310283        POP       RBX
    311         MOV       EAX,EDX
    312 {$ELSE}
     284{$ENDIF}
     285end;
     286
     287function CPU_Features: Integer;
     288asm
     289{$IFDEF TARGET_x86}
    313290        PUSH      EBX
    314291        MOV       EAX,1
     
    321298        MOV       EAX,EDX
    322299{$ENDIF}
     300{$IFDEF TARGET_x64}
     301        PUSH      RBX
     302        MOV       EAX,1
     303        CPUID
     304        POP       RBX
     305        MOV       EAX,EDX
     306{$ENDIF}
    323307end;
    324308
    325309function CPU_ExtensionsAvailable: Boolean;
    326310asm
    327 {$IFDEF TARGET_x64}
    328         PUSH      RBX
    329         MOV       @Result, True
    330         MOV       EAX, $80000000
    331         CPUID
    332         CMP       EAX, $80000000
    333         JBE       @NOEXTENSION
    334         JMP       @EXIT
    335         @NOEXTENSION:
    336         MOV       @Result, False
    337         @EXIT:
    338         POP       RBX
    339 {$ELSE}
     311{$IFDEF TARGET_x86}
    340312        PUSH      EBX
    341313        MOV       @Result, True
     
    354326        POP       EBX
    355327{$ENDIF}
     328{$IFDEF TARGET_x64}
     329        PUSH      RBX
     330        MOV       @Result, True
     331        MOV       EAX, $80000000
     332        CPUID
     333        CMP       EAX, $80000000
     334        JBE       @NOEXTENSION
     335        JMP       @EXIT
     336        @NOEXTENSION:
     337        MOV       @Result, False
     338        @EXIT:
     339        POP       RBX
     340{$ENDIF}
    356341end;
    357342
    358343function CPU_ExtFeatures: Integer;
    359344asm
    360 {$IFDEF TARGET_x64}
    361         PUSH      RBX
    362         MOV       EAX, $80000001
    363         CPUID
    364         POP       RBX
    365         MOV       EAX,EDX
    366 {$ELSE}
     345{$IFDEF TARGET_x86}
    367346        PUSH      EBX
    368347        MOV       EAX, $80000001
     
    373352        {$ENDIF}
    374353        POP       EBX
     354        MOV       EAX,EDX
     355{$ENDIF}
     356{$IFDEF TARGET_x64}
     357        PUSH      RBX
     358        MOV       EAX, $80000001
     359        CPUID
     360        POP       RBX
    375361        MOV       EAX,EDX
    376362{$ENDIF}
  • GraphicTest/Packages/Graphics32/GR32_Transforms.pas

    r450 r522  
    4848  Windows,
    4949{$ENDIF}
    50   SysUtils, Classes, GR32, GR32_Blend, GR32_VectorMaps, GR32_Rasterizers;
     50  SysUtils, Classes, Types, GR32, GR32_VectorMaps, GR32_Rasterizers;
    5151
    5252type
     
    5555
    5656type
    57   TFloatMatrix = array[0..2, 0..2] of TFloat;     // 3x3 TFloat precision
    58   TFixedMatrix = array[0..2, 0..2] of TFixed;     // 3x3 fixed precision
     57  TFloatMatrix = array [0..2, 0..2] of TFloat;     // 3x3 TFloat precision
     58  TFixedMatrix = array [0..2, 0..2] of TFixed;     // 3x3 fixed precision
    5959
    6060const
     
    6565
    6666type
    67   TVector3f = array[0..2] of TFloat;
    68   TVector3i = array[0..2] of Integer;
     67  TVector3f = array [0..2] of TFloat;
     68  TVector3i = array [0..2] of Integer;
    6969
    7070// Matrix conversion routines
     
    9494    procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); virtual;
    9595  public
     96    constructor Create; virtual;
    9697    procedure Changed; override;
    9798    function HasTransformedBounds: Boolean; virtual;
     
    106107    property SrcRect: TFloatRect read FSrcRect write SetSrcRect;
    107108  end;
    108 
    109   TAffineTransformation = class(TTransformation)
     109  TTransformationClass = class of TTransformation;
     110
     111  TNestedTransformation = class(TTransformation)
     112  private
     113    FItems: TList;
     114    FOwner: TPersistent;
     115    function GetCount: Integer;
     116    function GetItem(Index: Integer): TTransformation;
     117    procedure SetItem(Index: Integer; const Value: TTransformation);
    110118  protected
    111     FInverseMatrix: TFloatMatrix;
     119    procedure PrepareTransform; override;
     120    procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
     121    procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
     122    procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
     123    procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); override;
     124  public
     125    constructor Create; override;
     126    destructor Destroy; override;
     127    function Add(ItemClass: TTransformationClass): TTransformation;
     128    procedure Clear;
     129    procedure Delete(Index: Integer);
     130    function Insert(Index: Integer; ItemClass: TTransformationClass): TTransformation;
     131
     132    property Owner: TPersistent read FOwner;
     133    property Count: Integer read GetCount;
     134    property Items[Index: Integer]: TTransformation read GetItem write SetItem; default;
     135  end;
     136
     137  T3x3Transformation = class(TTransformation)
     138  protected
     139    FMatrix, FInverseMatrix: TFloatMatrix;
    112140    FFixedMatrix, FInverseFixedMatrix: TFixedMatrix;
    113141    procedure PrepareTransform; override;
     142    procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
    114143    procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
    115     procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
     144    procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
    116145    procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); override;
    117     procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
    118146  public
    119     Matrix: TFloatMatrix;
    120     constructor Create; virtual;
     147    property Matrix: TFloatMatrix read FMatrix;
     148  end;
     149
     150  TAffineTransformation = class(T3x3Transformation)
     151  private
     152    FStack: ^TFloatMatrix;
     153    FStackLevel: Integer;
     154  public
     155    constructor Create; override;
     156
    121157    function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
    122     procedure Clear;
     158    procedure Push;
     159    procedure Pop;
     160    procedure Clear; overload;
     161    procedure Clear(BaseMatrix: TFloatMatrix); overload;
    123162    procedure Rotate(Alpha: TFloat); overload; // degrees
    124163    procedure Rotate(Cx, Cy, Alpha: TFloat); overload; // degrees
     
    129168  end;
    130169
    131   TProjectiveTransformation = class(TTransformation)
     170  TProjectiveTransformation = class(T3x3Transformation)
    132171  private
    133     Wx0, Wx1, Wx2, Wx3: TFloat;
    134     Wy0, Wy1, Wy2, Wy3: TFloat;
    135     procedure SetX0(Value: TFloat);
    136     procedure SetX1(Value: TFloat);
    137     procedure SetX2(Value: TFloat);
    138     procedure SetX3(Value: TFloat);
    139     procedure SetY0(Value: TFloat);
    140     procedure SetY1(Value: TFloat);
    141     procedure SetY2(Value: TFloat);
    142     procedure SetY3(Value: TFloat);
     172    FQuadX: array [0..3] of TFloat;
     173    FQuadY: array [0..3] of TFloat;
     174    procedure SetX(Index: Integer; const Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
     175    procedure SetY(Index: Integer; const Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
     176    function GetX(Index: Integer): TFloat; {$IFDEF UseInlining} inline; {$ENDIF}
     177    function GetY(Index: Integer): TFloat; {$IFDEF UseInlining} inline; {$ENDIF}
    143178  protected
    144     FMatrix, FInverseMatrix: TFloatMatrix;
    145     FFixedMatrix, FInverseFixedMatrix: TFixedMatrix;
    146179    procedure PrepareTransform; override;
     180    procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
    147181    procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
    148     procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
     182    procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
    149183    procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); override;
    150     procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
    151184  public
    152     function  GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
     185    function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
     186    property X[Index: Integer]: TFloat read GetX write SetX;
     187    property Y[index: Integer]: TFloat read GetX write SetY;
    153188  published
    154     property X0: TFloat read Wx0 write SetX0;
    155     property X1: TFloat read Wx1 write SetX1;
    156     property X2: TFloat read Wx2 write SetX2;
    157     property X3: TFloat read Wx3 write SetX3;
    158     property Y0: TFloat read Wy0 write SetY0;
    159     property Y1: TFloat read Wy1 write SetY1;
    160     property Y2: TFloat read Wy2 write SetY2;
    161     property Y3: TFloat read Wy3 write SetY3;
     189    property X0: TFloat index 0 read GetX write SetX;
     190    property X1: TFloat index 1 read GetX write SetX;
     191    property X2: TFloat index 2 read GetX write SetX;
     192    property X3: TFloat index 3 read GetX write SetX;
     193    property Y0: TFloat index 0 read GetY write SetY;
     194    property Y1: TFloat index 1 read GetY write SetY;
     195    property Y2: TFloat index 2 read GetY write SetY;
     196    property Y3: TFloat index 3 read GetY write SetY;
    162197  end;
    163198
     
    171206    procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
    172207  public
    173     constructor Create; virtual;
     208    constructor Create; override;
    174209    function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
    175210  published
     
    186221    procedure PrepareTransform; override;
    187222    procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
     223    procedure TransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
    188224  public
    189     constructor Create; virtual;
     225    constructor Create; override;
    190226  published
    191227    property BloatPower: TFloat read FBloatPower write SetBloatPower;
     
    277313    procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
    278314  public
    279     constructor Create; virtual;
     315    constructor Create; override;
    280316    destructor Destroy; override;
    281317    function HasTransformedBounds: Boolean; override;
     
    316352
    317353uses
    318   Math, GR32_LowLevel, GR32_Math, GR32_System, GR32_Bindings, GR32_Resamplers;
     354  Math, GR32_Blend, GR32_LowLevel, GR32_Math, GR32_Bindings,
     355  GR32_Resamplers;
    319356
    320357resourcestring
    321358  RCStrSrcRectIsEmpty = 'SrcRect is empty!';
    322359  RCStrMappingRectIsEmpty = 'MappingRect is empty!';
     360  RStrStackEmpty = 'Stack empty';
    323361
    324362type
     
    516554  Transformer: TTransformer;
    517555begin
    518   IntersectRect(DstRect, DstClip, Dst.ClipRect);
     556  GR32.IntersectRect(DstRect, DstClip, Dst.ClipRect);
    519557
    520558  if (DstRect.Right < DstRect.Left) or (DstRect.Bottom < DstRect.Top) then Exit;
     
    538576  I: Integer;
    539577begin
    540   IntersectRect(ARect, ARect, ABitmap.BoundsRect);
     578  GR32.IntersectRect(ARect, ARect, ABitmap.BoundsRect);
    541579  with ARect, ABitmap do
    542580  if (Right > Left) and (Bottom > Top) and
     
    573611end;
    574612
     613constructor TTransformation.Create;
     614begin
     615  // virtual constructor to be overriden in derived classes
     616end;
     617
    575618function TTransformation.GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect;
    576619begin
     
    619662  out SrcX, SrcY: TFloat);
    620663begin
    621   // ReverseTransformFloat is the top precisionlevel, all decendants must override at least this level!
     664  // ReverseTransformFloat is the top precisionlevel, all descendants must override at least this level!
    622665  raise ETransformNotImplemented.CreateFmt(RCStrReverseTransformationNotImplemented, [Self.Classname]);
    623666end;
     
    641684function TTransformation.Transform(const P: TFloatPoint): TFloatPoint;
    642685begin
    643   If not TransformValid then PrepareTransform;
     686  if not TransformValid then PrepareTransform;
    644687  TransformFloat(P.X, P.Y, Result.X, Result.Y);
    645688end;
     
    647690function TTransformation.Transform(const P: TFixedPoint): TFixedPoint;
    648691begin
    649   If not TransformValid then PrepareTransform;
     692  if not TransformValid then PrepareTransform;
    650693  TransformFixed(P.X, P.Y, Result.X, Result.Y);
    651694end;
     
    653696function TTransformation.Transform(const P: TPoint): TPoint;
    654697begin
    655   If not TransformValid then PrepareTransform;
     698  if not TransformValid then PrepareTransform;
    656699  TransformInt(P.X, P.Y, Result.X, Result.Y);
    657700end;
     
    669712procedure TTransformation.TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat);
    670713begin
    671   // TransformFloat is the top precisionlevel, all decendants must override at least this level!
     714  // TransformFloat is the top precisionlevel, all descendants must override at least this level!
    672715  raise ETransformNotImplemented.CreateFmt(RCStrForwardTransformationNotImplemented, [Self.Classname]);
    673716end;
     
    682725end;
    683726
     727
     728{ TNestedTransformation }
     729
     730constructor TNestedTransformation.Create;
     731begin
     732  FItems := TList.Create;
     733end;
     734
     735destructor TNestedTransformation.Destroy;
     736begin
     737  if Assigned(FItems) then Clear;
     738  FItems.Free;
     739  inherited;
     740end;
     741
     742function TNestedTransformation.Add(
     743  ItemClass: TTransformationClass): TTransformation;
     744begin
     745  Result := ItemClass.Create;
     746  {$IFDEF NEXTGEN}
     747  Result.__ObjAddRef;
     748  {$ENDIF}
     749  FItems.Add(Result);
     750end;
     751
     752procedure TNestedTransformation.Clear;
     753begin
     754  BeginUpdate;
     755  try
     756    while FItems.Count > 0 do
     757      Delete(FItems.Count - 1);
     758  finally
     759    EndUpdate;
     760  end;
     761end;
     762
     763procedure TNestedTransformation.Delete(Index: Integer);
     764begin
     765  TTransformation(FItems[Index]).Free;
     766  FItems.Delete(Index);
     767end;
     768
     769function TNestedTransformation.GetCount: Integer;
     770begin
     771  Result := FItems.Count;
     772end;
     773
     774function TNestedTransformation.GetItem(Index: Integer): TTransformation;
     775begin
     776  Result := FItems[Index];
     777end;
     778
     779function TNestedTransformation.Insert(Index: Integer;
     780  ItemClass: TTransformationClass): TTransformation;
     781begin
     782  BeginUpdate;
     783  try
     784    Result := Add(ItemClass);
     785  finally
     786    EndUpdate;
     787  end;
     788end;
     789
     790procedure TNestedTransformation.PrepareTransform;
     791var
     792  Index: Integer;
     793begin
     794  for Index := 0 to Count - 1 do
     795    TTransformation(FItems[Index]).PrepareTransform;
     796end;
     797
     798procedure TNestedTransformation.ReverseTransformFixed(DstX, DstY: TFixed;
     799  out SrcX, SrcY: TFixed);
     800var
     801  Index: Integer;
     802begin
     803  for Index := 0 to Count - 1 do
     804  begin
     805    TTransformation(FItems[Index]).ReverseTransformFixed(DstX, DstY, SrcX,
     806      SrcY);
     807    DstX := SrcX;
     808    DstY := SrcY;
     809  end;
     810end;
     811
     812procedure TNestedTransformation.ReverseTransformFloat(DstX, DstY: TFloat;
     813  out SrcX, SrcY: TFloat);
     814var
     815  Index: Integer;
     816begin
     817  for Index := 0 to Count - 1 do
     818  begin
     819    TTransformation(FItems[Index]).ReverseTransformFloat(DstX, DstY, SrcX,
     820      SrcY);
     821    DstX := SrcX;
     822    DstY := SrcY;
     823  end;
     824end;
     825
     826procedure TNestedTransformation.SetItem(Index: Integer;
     827  const Value: TTransformation);
     828begin
     829  TCollectionItem(FItems[Index]).Assign(Value);
     830end;
     831
     832procedure TNestedTransformation.TransformFixed(SrcX, SrcY: TFixed; out DstX,
     833  DstY: TFixed);
     834var
     835  Index: Integer;
     836begin
     837  for Index := 0 to Count - 1 do
     838  begin
     839    TTransformation(FItems[Index]).TransformFixed(SrcX, SrcY, DstX, DstY);
     840    SrcX := DstX;
     841    SrcY := DstY;
     842  end;
     843end;
     844
     845procedure TNestedTransformation.TransformFloat(SrcX, SrcY: TFloat; out DstX,
     846  DstY: TFloat);
     847var
     848  Index: Integer;
     849begin
     850  for Index := 0 to Count - 1 do
     851  begin
     852    TTransformation(FItems[Index]).TransformFloat(SrcX, SrcY, DstX, DstY);
     853    SrcX := DstX;
     854    SrcY := DstY;
     855  end;
     856end;
     857
     858
     859{ T3x3Transformation }
     860
     861procedure T3x3Transformation.PrepareTransform;
     862begin
     863  FInverseMatrix := Matrix;
     864  Invert(FInverseMatrix);
     865
     866  // calculate a fixed point (65536) factors
     867  FInverseFixedMatrix := FixedMatrix(FInverseMatrix);
     868  FFixedMatrix := FixedMatrix(Matrix);
     869
     870  TransformValid := True;
     871end;
     872
     873procedure T3x3Transformation.ReverseTransformFixed(DstX, DstY: TFixed; out SrcX,
     874  SrcY: TFixed);
     875begin
     876  SrcX := FixedMul(DstX, FInverseFixedMatrix[0, 0]) +
     877    FixedMul(DstY, FInverseFixedMatrix[1, 0]) + FInverseFixedMatrix[2, 0];
     878  SrcY := FixedMul(DstX, FInverseFixedMatrix[0, 1]) +
     879    FixedMul(DstY, FInverseFixedMatrix[1, 1]) + FInverseFixedMatrix[2, 1];
     880end;
     881
     882procedure T3x3Transformation.ReverseTransformFloat(DstX, DstY: TFloat; out SrcX,
     883  SrcY: TFloat);
     884begin
     885  SrcX := DstX * FInverseMatrix[0, 0] + DstY * FInverseMatrix[1, 0] +
     886    FInverseMatrix[2, 0];
     887  SrcY := DstX * FInverseMatrix[0, 1] + DstY * FInverseMatrix[1, 1] +
     888    FInverseMatrix[2, 1];
     889end;
     890
     891procedure T3x3Transformation.TransformFixed(SrcX, SrcY: TFixed; out DstX,
     892  DstY: TFixed);
     893begin
     894  DstX := FixedMul(SrcX, FFixedMatrix[0, 0]) +
     895    FixedMul(SrcY, FFixedMatrix[1, 0]) + FFixedMatrix[2, 0];
     896  DstY := FixedMul(SrcX, FFixedMatrix[0, 1]) +
     897    FixedMul(SrcY, FFixedMatrix[1, 1]) + FFixedMatrix[2, 1];
     898end;
     899
     900procedure T3x3Transformation.TransformFloat(SrcX, SrcY: TFloat; out DstX,
     901  DstY: TFloat);
     902begin
     903  DstX := SrcX * Matrix[0, 0] + SrcY * Matrix[1, 0] + Matrix[2, 0];
     904  DstY := SrcX * Matrix[0, 1] + SrcY * Matrix[1, 1] + Matrix[2, 1];
     905end;
     906
     907
    684908{ TAffineTransformation }
    685909
     910constructor TAffineTransformation.Create;
     911begin
     912  FStackLevel := 0;
     913  FStack := nil;
     914  Clear;
     915end;
     916
    686917procedure TAffineTransformation.Clear;
    687918begin
    688   Matrix := IdentityMatrix;
    689   Changed;
    690 end;
    691 
    692 constructor TAffineTransformation.Create;
    693 begin
    694   Clear;
     919  FMatrix := IdentityMatrix;
     920  Changed;
     921end;
     922
     923procedure TAffineTransformation.Clear(BaseMatrix: TFloatMatrix);
     924begin
     925  FMatrix := BaseMatrix;
     926  Changed;
    695927end;
    696928
     
    713945end;
    714946
    715 procedure TAffineTransformation.PrepareTransform;
    716 begin
    717   FInverseMatrix := Matrix;
    718   Invert(FInverseMatrix);
    719 
    720   // calculate a fixed point (65536) factors
    721   FInverseFixedMatrix := FixedMatrix(FInverseMatrix);
    722   FFixedMatrix := FixedMatrix(Matrix);
    723 
    724   TransformValid := True;
     947procedure TAffineTransformation.Push;
     948begin
     949  Inc(FStackLevel);
     950  ReallocMem(FStack, FStackLevel * SizeOf(TFloatMatrix));
     951  Move(FMatrix, FStack^[FStackLevel - 1], SizeOf(TFloatMatrix));
     952end;
     953
     954procedure TAffineTransformation.Pop;
     955begin
     956  if FStackLevel <= 0 then
     957    raise Exception.Create(RStrStackEmpty);
     958
     959  Move(FStack^[FStackLevel - 1], FMatrix, SizeOf(TFloatMatrix));
     960  Dec(FStackLevel);
     961  Changed;
    725962end;
    726963
     
    735972  M[0, 0] := C;   M[1, 0] := S;
    736973  M[0, 1] := -S;  M[1, 1] := C;
    737   Matrix := Mult(M, Matrix);
     974  FMatrix := Mult(M, Matrix);
    738975  Changed;
    739976end;
     
    750987  M[0, 0] := C;   M[1, 0] := S;
    751988  M[0, 1] := -S;  M[1, 1] := C;
    752   Matrix := Mult(M, Matrix);
     989  FMatrix := Mult(M, Matrix);
    753990  if (Cx <> 0) or (Cy <> 0) then Translate(Cx, Cy);
    754991  Changed;
     
    762999  M[0, 0] := Sx;
    7631000  M[1, 1] := Sy;
    764   Matrix := Mult(M, Matrix);
     1001  FMatrix := Mult(M, Matrix);
    7651002  Changed;
    7661003end;
     
    7731010  M[0, 0] := Value;
    7741011  M[1, 1] := Value;
    775   Matrix := Mult(M, Matrix);
     1012  FMatrix := Mult(M, Matrix);
    7761013  Changed;
    7771014end;
     
    7841021  M[1, 0] := Fx;
    7851022  M[0, 1] := Fy;
    786   Matrix := Mult(M, Matrix);
    787   Changed; 
    788 end;
    789 
    790 procedure TAffineTransformation.ReverseTransformFloat(
    791   DstX, DstY: TFloat;
    792   out SrcX, SrcY: TFloat);
    793 begin
    794   SrcX := DstX * FInverseMatrix[0,0] + DstY * FInverseMatrix[1,0] + FInverseMatrix[2,0];
    795   SrcY := DstX * FInverseMatrix[0,1] + DstY * FInverseMatrix[1,1] + FInverseMatrix[2,1];
    796 end;
    797 
    798 procedure TAffineTransformation.ReverseTransformFixed(
    799   DstX, DstY: TFixed;
    800   out SrcX, SrcY: TFixed);
    801 begin
    802   SrcX := FixedMul(DstX, FInverseFixedMatrix[0,0]) + FixedMul(DstY, FInverseFixedMatrix[1,0]) + FInverseFixedMatrix[2,0];
    803   SrcY := FixedMul(DstX, FInverseFixedMatrix[0,1]) + FixedMul(DstY, FInverseFixedMatrix[1,1]) + FInverseFixedMatrix[2,1];
    804 end;
    805 
    806 procedure TAffineTransformation.TransformFloat(
    807   SrcX, SrcY: TFloat;
    808   out DstX, DstY: TFloat);
    809 begin
    810   DstX := SrcX * Matrix[0,0] + SrcY * Matrix[1,0] + Matrix[2,0];
    811   DstY := SrcX * Matrix[0,1] + SrcY * Matrix[1,1] + Matrix[2,1];
    812 end;
    813 
    814 procedure TAffineTransformation.TransformFixed(
    815   SrcX, SrcY: TFixed;
    816   out DstX, DstY: TFixed);
    817 begin
    818   DstX := FixedMul(SrcX, FFixedMatrix[0,0]) + FixedMul(SrcY, FFixedMatrix[1,0]) + FFixedMatrix[2,0];
    819   DstY := FixedMul(SrcX, FFixedMatrix[0,1]) + FixedMul(SrcY, FFixedMatrix[1,1]) + FFixedMatrix[2,1];
     1023  FMatrix := Mult(M, Matrix);
     1024  Changed;
    8201025end;
    8211026
     
    8251030begin
    8261031  M := IdentityMatrix;
    827   M[2,0] := Dx;
    828   M[2,1] := Dy;
    829   Matrix := Mult(M, Matrix);
    830   Changed; 
     1032  M[2, 0] := Dx;
     1033  M[2, 1] := Dy;
     1034  FMatrix := Mult(M, Matrix);
     1035
     1036  Changed;
    8311037end;
    8321038
     
    8361042function TProjectiveTransformation.GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect;
    8371043begin
    838   Result.Left   := Min(Min(Wx0, Wx1), Min(Wx2, Wx3));
    839   Result.Right  := Max(Max(Wx0, Wx1), Max(Wx2, Wx3));
    840   Result.Top    := Min(Min(Wy0, Wy1), Min(Wy2, Wy3));
    841   Result.Bottom := Max(Max(Wy0, Wy1), Max(Wy2, Wy3));
     1044  Result.Left   := Min(Min(FQuadX[0], FQuadX[1]), Min(FQuadX[2], FQuadX[3]));
     1045  Result.Right  := Max(Max(FQuadX[0], FQuadX[1]), Max(FQuadX[2], FQuadX[3]));
     1046  Result.Top    := Min(Min(FQuadY[0], FQuadY[1]), Min(FQuadY[2], FQuadY[3]));
     1047  Result.Bottom := Max(Max(FQuadY[0], FQuadY[1]), Max(FQuadY[2], FQuadY[3]));
     1048end;
     1049
     1050function TProjectiveTransformation.GetX(Index: Integer): TFloat;
     1051begin
     1052  Result := FQuadX[Index];
     1053end;
     1054
     1055function TProjectiveTransformation.GetY(Index: Integer): TFloat;
     1056begin
     1057  Result := FQuadY[Index];
    8421058end;
    8431059
     
    8481064  R: TFloatMatrix;
    8491065begin
    850   px  := Wx0 - Wx1 + Wx2 - Wx3;
    851   py  := Wy0 - Wy1 + Wy2 - Wy3;
     1066  px  := FQuadX[0] - FQuadX[1] + FQuadX[2] - FQuadX[3];
     1067  py  := FQuadY[0] - FQuadY[1] + FQuadY[2] - FQuadY[3];
    8521068
    8531069  if (px = 0) and (py = 0) then
    8541070  begin
    8551071    // affine mapping
    856     FMatrix[0,0] := Wx1 - Wx0;
    857     FMatrix[1,0] := Wx2 - Wx1;
    858     FMatrix[2,0] := Wx0;
    859 
    860     FMatrix[0,1] := Wy1 - Wy0;
    861     FMatrix[1,1] := Wy2 - Wy1;
    862     FMatrix[2,1] := Wy0;
    863 
    864     FMatrix[0,2] := 0;
    865     FMatrix[1,2] := 0;
    866     FMatrix[2,2] := 1;
     1072    FMatrix[0, 0] := FQuadX[1] - FQuadX[0];
     1073    FMatrix[1, 0] := FQuadX[2] - FQuadX[1];
     1074    FMatrix[2, 0] := FQuadX[0];
     1075
     1076    FMatrix[0, 1] := FQuadY[1] - FQuadY[0];
     1077    FMatrix[1, 1] := FQuadY[2] - FQuadY[1];
     1078    FMatrix[2, 1] := FQuadY[0];
     1079
     1080    FMatrix[0, 2] := 0;
     1081    FMatrix[1, 2] := 0;
     1082    FMatrix[2, 2] := 1;
    8671083  end
    8681084  else
    8691085  begin
    8701086    // projective mapping
    871     dx1 := Wx1 - Wx2;
    872     dx2 := Wx3 - Wx2;
    873     dy1 := Wy1 - Wy2;
    874     dy2 := Wy3 - Wy2;
     1087    dx1 := FQuadX[1] - FQuadX[2];
     1088    dx2 := FQuadX[3] - FQuadX[2];
     1089    dy1 := FQuadY[1] - FQuadY[2];
     1090    dy2 := FQuadY[3] - FQuadY[2];
    8751091    k := dx1 * dy2 - dx2 * dy1;
    8761092    if k <> 0 then
     
    8801096      h := (dx1 * py - dy1 * px) * k;
    8811097
    882       FMatrix[0,0] := Wx1 - Wx0 + g * Wx1;
    883       FMatrix[1,0] := Wx3 - Wx0 + h * Wx3;
    884       FMatrix[2,0] := Wx0;
    885 
    886       FMatrix[0,1] := Wy1 - Wy0 + g * Wy1;
    887       FMatrix[1,1] := Wy3 - Wy0 + h * Wy3;
    888       FMatrix[2,1] := Wy0;
    889 
    890       FMatrix[0,2] := g;
    891       FMatrix[1,2] := h;
    892       FMatrix[2,2] := 1;
     1098      FMatrix[0, 0] := FQuadX[1] - FQuadX[0] + g * FQuadX[1];
     1099      FMatrix[1, 0] := FQuadX[3] - FQuadX[0] + h * FQuadX[3];
     1100      FMatrix[2, 0] := FQuadX[0];
     1101
     1102      FMatrix[0, 1] := FQuadY[1] - FQuadY[0] + g * FQuadY[1];
     1103      FMatrix[1, 1] := FQuadY[3] - FQuadY[0] + h * FQuadY[3];
     1104      FMatrix[2, 1] := FQuadY[0];
     1105
     1106      FMatrix[0, 2] := g;
     1107      FMatrix[1, 2] := h;
     1108      FMatrix[2, 2] := 1;
    8931109    end
    8941110    else
     
    9001116  // denormalize texture space (u, v)
    9011117  R := IdentityMatrix;
    902   R[0,0] := 1 / (SrcRect.Right - SrcRect.Left);
    903   R[1,1] := 1 / (SrcRect.Bottom - SrcRect.Top);
     1118  R[0, 0] := 1 / (SrcRect.Right - SrcRect.Left);
     1119  R[1, 1] := 1 / (SrcRect.Bottom - SrcRect.Top);
    9041120  FMatrix := Mult(FMatrix, R);
    9051121
    9061122  R := IdentityMatrix;
    907   R[2,0] := -SrcRect.Left;
    908   R[2,1] := -SrcRect.Top;
     1123  R[2, 0] := -SrcRect.Left;
     1124  R[2, 1] := -SrcRect.Top;
    9091125  FMatrix := Mult(FMatrix, R);
    9101126
    911   FInverseMatrix := FMatrix;
    912   Invert(FInverseMatrix);
    913 
    914   FInverseFixedMatrix := FixedMatrix(FInverseMatrix);
    915   FFixedMatrix := FixedMatrix(FMatrix);
    916 
    917   TransformValid := True;
    918 end;
    919 
    920 procedure TProjectiveTransformation.SetX0(Value: TFloat);
    921 begin
    922   Wx0 := Value;
    923   Changed;
    924 end;
    925 
    926 procedure TProjectiveTransformation.SetX1(Value: TFloat);
    927 begin
    928   Wx1 := Value;
    929   Changed;
    930 end;
    931 
    932 procedure TProjectiveTransformation.SetX2(Value: TFloat);
    933 begin
    934   Wx2 := Value;
    935   Changed;
    936 end;
    937 
    938 procedure TProjectiveTransformation.SetX3(Value: TFloat);
    939 begin
    940   Wx3 := Value;
    941   Changed;
    942 end;
    943 
    944 procedure TProjectiveTransformation.SetY0(Value: TFloat);
    945 begin
    946   Wy0 := Value;
    947   Changed;
    948 end;
    949 
    950 procedure TProjectiveTransformation.SetY1(Value: TFloat);
    951 begin
    952   Wy1 := Value;
    953   Changed;
    954 end;
    955 
    956 procedure TProjectiveTransformation.SetY2(Value: TFloat);
    957 begin
    958   Wy2 := Value;
    959   Changed;
    960 end;
    961 
    962 procedure TProjectiveTransformation.SetY3(Value: TFloat);
    963 begin
    964   Wy3 := Value;
    965   Changed;
    966 end;
    967 
    968 procedure TProjectiveTransformation.ReverseTransformFloat(
    969   DstX, DstY: TFloat;
    970   out SrcX, SrcY: TFloat);
    971 var
    972   X, Y, Z: TFloat;
    973 begin
    974   EMMS;
    975   X := DstX; Y := DstY;
    976   Z := FInverseMatrix[0,2] * X + FInverseMatrix[1,2] * Y + FInverseMatrix[2,2];
    977 
    978   if Z = 0 then Exit
    979   else if Z = 1 then
    980   begin
    981     SrcX := FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0];
    982     SrcY := FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1];
    983   end
    984   else
    985   begin
    986     Z := 1 / Z;
    987     SrcX := (FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]) * Z;
    988     SrcY := (FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]) * Z;
    989   end;
     1127  inherited;
     1128end;
     1129
     1130procedure TProjectiveTransformation.SetX(Index: Integer; const Value: TFloat);
     1131begin
     1132  FQuadX[Index] := Value;
     1133  Changed;
     1134end;
     1135
     1136procedure TProjectiveTransformation.SetY(Index: Integer; const Value: TFloat);
     1137begin
     1138  FQuadY[Index] := Value;
     1139  Changed;
    9901140end;
    9911141
     
    9961146  Zf: TFloat;
    9971147begin
    998   Z := FixedMul(FInverseFixedMatrix[0,2], DstX) +
    999        FixedMul(FInverseFixedMatrix[1,2], DstY) +
    1000        FInverseFixedMatrix[2,2];
     1148  Z := FixedMul(FInverseFixedMatrix[0, 2], DstX) +
     1149    FixedMul(FInverseFixedMatrix[1, 2], DstY) + FInverseFixedMatrix[2, 2];
    10011150
    10021151  if Z = 0 then Exit;
    10031152
    1004   SrcX := FixedMul(FInverseFixedMatrix[0,0], DstX) +
    1005           FixedMul(FInverseFixedMatrix[1,0], DstY) +
    1006           FInverseFixedMatrix[2,0];
    1007 
    1008   SrcY := FixedMul(FInverseFixedMatrix[0,1], DstX) +
    1009           FixedMul(FInverseFixedMatrix[1,1], DstY) +
    1010           FInverseFixedMatrix[2,1];
     1153  {$IFDEF UseInlining}
     1154  SrcX := FixedMul(DstX, FInverseFixedMatrix[0, 0]) +
     1155    FixedMul(DstY, FInverseFixedMatrix[1, 0]) + FInverseFixedMatrix[2, 0];
     1156  SrcY := FixedMul(DstX, FInverseFixedMatrix[0,1]) +
     1157    FixedMul(DstY, FInverseFixedMatrix[1, 1]) + FInverseFixedMatrix[2, 1];
     1158  {$ELSE}
     1159  inherited;
     1160  {$ENDIF}
    10111161
    10121162  if Z <> FixedOne then
     
    10191169end;
    10201170
     1171procedure TProjectiveTransformation.ReverseTransformFloat(
     1172  DstX, DstY: TFloat;
     1173  out SrcX, SrcY: TFloat);
     1174var
     1175  Z: TFloat;
     1176begin
     1177  EMMS;
     1178  Z := FInverseMatrix[0, 2] * DstX + FInverseMatrix[1, 2] * DstY +
     1179    FInverseMatrix[2, 2];
     1180
     1181  if Z = 0 then Exit;
     1182
     1183  {$IFDEF UseInlining}
     1184  SrcX := DstX * FInverseMatrix[0, 0] + DstY * FInverseMatrix[1, 0] +
     1185    FInverseMatrix[2, 0];
     1186  SrcY := DstX * FInverseMatrix[0, 1] + DstY * FInverseMatrix[1, 1] +
     1187    FInverseMatrix[2, 1];
     1188  {$ELSE}
     1189  inherited;
     1190  {$ENDIF}
     1191
     1192  if Z <> 1 then
     1193  begin
     1194    Z := 1 / Z;
     1195    SrcX := SrcX * Z;
     1196    SrcY := SrcY * Z;
     1197  end;
     1198end;
    10211199
    10221200procedure TProjectiveTransformation.TransformFixed(SrcX, SrcY: TFixed;
     
    10261204  Zf: TFloat;
    10271205begin
    1028   Z := FixedMul(FFixedMatrix[0,2], SrcX) +
    1029        FixedMul(FFixedMatrix[1,2], SrcY) +
    1030        FFixedMatrix[2,2];
     1206  Z := FixedMul(FFixedMatrix[0, 2], SrcX) +
     1207    FixedMul(FFixedMatrix[1, 2], SrcY) + FFixedMatrix[2, 2];
    10311208
    10321209  if Z = 0 then Exit;
    10331210
    1034   DstX := FixedMul(FFixedMatrix[0,0], SrcX) +
    1035           FixedMul(FFixedMatrix[1,0], SrcY) +
    1036           FFixedMatrix[2,0];
    1037 
    1038   DstY := FixedMul(FFixedMatrix[0,1], SrcX) +
    1039           FixedMul(FFixedMatrix[1,1], SrcY) +
    1040           FFixedMatrix[2,1];
     1211  {$IFDEF UseInlining}
     1212  DstX := FixedMul(SrcX, FFixedMatrix[0, 0]) +
     1213    FixedMul(SrcY, FFixedMatrix[1, 0]) + FFixedMatrix[2, 0];
     1214  DstY := FixedMul(SrcX, FFixedMatrix[0, 1]) +
     1215    FixedMul(SrcY, FFixedMatrix[1, 1]) + FFixedMatrix[2, 1];
     1216  {$ELSE}
     1217  inherited;
     1218  {$ENDIF}
    10411219
    10421220  if Z <> FixedOne then
     
    10521230  out DstX, DstY: TFloat);
    10531231var
    1054   X, Y, Z: TFloat;
     1232  Z: TFloat;
    10551233begin
    10561234  EMMS;
    1057   X := SrcX; Y := SrcY;
    1058   Z := FMatrix[0,2] * X + FMatrix[1,2] * Y + FMatrix[2,2];
    1059 
    1060   if Z = 0 then Exit
    1061   else if Z = 1 then
    1062   begin
    1063     DstX := FMatrix[0,0] * X + FMatrix[1,0] * Y + FMatrix[2,0];
    1064     DstY := FMatrix[0,1] * X + FMatrix[1,1] * Y + FMatrix[2,1];
    1065   end
    1066   else
     1235  Z := FMatrix[0, 2] * SrcX + FMatrix[1, 2] * SrcY + FMatrix[2, 2];
     1236
     1237  if Z = 0 then Exit;
     1238
     1239  {$IFDEF UseInlining}
     1240  DstX := SrcX * Matrix[0, 0] + SrcY * Matrix[1, 0] + Matrix[2, 0];
     1241  DstY := SrcX * Matrix[0, 1] + SrcY * Matrix[1, 1] + Matrix[2, 1];
     1242  {$ELSE}
     1243  inherited;
     1244  {$ENDIF}
     1245
     1246  if Z <> 1 then
    10671247  begin
    10681248    Z := 1 / Z;
    1069     DstX := (FMatrix[0,0] * X + FMatrix[1,0] * Y + FMatrix[2,0]) * Z;
    1070     DstY := (FMatrix[0,1] * X + FMatrix[1,1] * Y + FMatrix[2,1]) * Z;
    1071   end;
    1072 end;
     1249    DstX := DstX * Z;
     1250    DstY := DstY * Z;
     1251  end;
     1252end;
     1253
    10731254
    10741255{ TTwirlTransformation }
     
    11481329  GR32_Math.SinCos(FPiH * DstY, SinY, CosY);
    11491330  GR32_Math.SinCos(FPiW * DstX, SinX, CosX);
     1331  t := FBP * SinY * SinX;
     1332  SrcX := DstX + t * CosX;
     1333  SrcY := DstY + t * CosY;
     1334end;
     1335
     1336procedure TBloatTransformation.TransformFloat(DstX, DstY: TFloat;
     1337  out SrcX, SrcY: TFloat);
     1338var
     1339  SinY, CosY, SinX, CosX, t: Single;
     1340begin
     1341  GR32_Math.SinCos(-FPiH * DstY, SinY, CosY);
     1342  GR32_Math.SinCos(-FPiW * DstX, SinX, CosX);
    11501343  t := FBP * SinY * SinX;
    11511344  SrcX := DstX + t * CosX;
     
    15801773  MapPtr: PFixedPointArray;
    15811774begin
    1582   IntersectRect(DstRect, VectorMap.BoundsRect, DstRect);
    1583   if IsRectEmpty(DstRect) then Exit;
     1775  GR32.IntersectRect(DstRect, VectorMap.BoundsRect, DstRect);
     1776  if GR32.IsRectEmpty(DstRect) then Exit;
    15841777
    15851778  if not TTransformationAccess(Transformation).TransformValid then
  • GraphicTest/Packages/Graphics32/GR32_VectorMaps.pas

    r450 r522  
    118118
    119119uses
    120   GR32_Lowlevel, GR32_Blend, GR32_Transforms, GR32_Math, SysUtils;
     120  GR32_Lowlevel, GR32_Math, SysUtils;
    121121
    122122resourcestring
     
    249249    {$IFDEF HAS_NATIVEINT}
    250250    Result := CombineVectorsReg(CombineVectorsReg(PFixedPoint(P)^,
    251       PFixedPoint(NativeUInt(P) + H)^, WX), CombineVectorsReg(
    252       PFixedPoint(NativeUInt(P) + W)^, PFixedPoint(NativeUInt(P) + W + H)^, WX),
    253       WY);
     251      PFixedPoint(NativeUInt(P) + NativeUInt(H))^, WX), CombineVectorsReg(
     252      PFixedPoint(NativeUInt(P) + NativeUInt(W))^,
     253      PFixedPoint(NativeUInt(P) + NativeUInt(W + H))^, WX), WY);
    254254    {$ELSE}
    255255    Result := CombineVectorsReg(CombineVectorsReg(PFixedPoint(P)^,
    256       PFixedPoint(Cardinal(P) + H)^, WX), CombineVectorsReg(
    257       PFixedPoint(Cardinal(P) + W)^, PFixedPoint(Cardinal(P) + W + H)^, WX),
    258       WY);
     256      PFixedPoint(Cardinal(P) + Cardinal(H))^, WX), CombineVectorsReg(
     257      PFixedPoint(Cardinal(P) + Cardinal(W))^,
     258      PFixedPoint(Cardinal(P) + Cardinal(W) + Cardinal(H))^, WX), WY);
    259259    {$ENDIF}
    260260  end else
     
    322322    Reset(MeshFile, 1);
    323323    BlockRead(MeshFile, Header, SizeOf(TPSLiquifyMeshHeader));
    324     if Lowercase(String(Header.Ident)) <> Lowercase(MeshIdent) then
     324    if LowerCase(string(Header.Ident)) <> LowerCase(MeshIdent) then
    325325      Exception.Create(RCStrBadFormat);
    326326    with Header do
     
    433433  var
    434434    I: Integer;
     435{$IFDEF COMPILERRX1}
     436    f: single;
     437{$ENDIF}
    435438  begin
    436439    for I := 0 to Length(FVectors) - 1 do
     
    438441      //Not a mistake! Converting physical mem. directly to avoid temporary floating point buffer
    439442      //Do no change to PFloat.. the type is relative to the msh format.
     443
     444//Workaround for Delphi 10.1 Internal Error C6949 ...
     445{$IFDEF COMPILERRX1}
     446      f := FVectors[I].X * FixedToFloat;
     447      FVectors[I].X := PInteger(@f)^;
     448      f := FVectors[I].Y * FixedToFloat;
     449      FVectors[I].Y := PInteger(@f)^;
     450{$ELSE}
    440451      PSingle(@FVectors[I].X)^ := FVectors[I].X * FixedToFloat;
    441452      PSingle(@FVectors[I].Y)^ := FVectors[I].Y * FixedToFloat;
     453{$ENDIF}
    442454    end;
    443455  end;
     
    589601      Inc(VectorPtr);
    590602      Inc(Top);
    591     until Top = Width * Height;
    592 
    593     TopDone: Top := Top div Width;
     603    until Top = Self.Width * Self.Height;
     604
     605    TopDone: Top := Top div Self.Width;
    594606
    595607    //Find Bottom
    596     Bottom := Width * Height - 1;
     608    Bottom := Self.Width * Self.Height - 1;
    597609    VectorPtr := @Vectors[Bottom];
    598610    repeat
     
    602614    until Bottom < 0;
    603615
    604     BottomDone: Bottom := Bottom div Width - 1;
     616    BottomDone: Bottom := Bottom div Self.Width - 1;
    605617
    606618    //Find Left
     
    613625      until J >= Bottom;
    614626      Inc(Left)
    615     until Left >= Width;
     627    until Left >= Self.Width;
    616628
    617629    LeftDone:
    618630
    619631    //Find Right
    620     Right := Width - 1;
     632    Right := Self.Width - 1;
    621633    repeat
    622634      J := Bottom;
     
    628640    until Right <= Left;
    629641
    630 
    631642  end;
    632643  RightDone:
    633644  if IsRectEmpty(Result) then
    634     Result := Rect(0,0,0,0);
     645    Result := Rect(0, 0, 0, 0);
    635646end;
    636647
  • GraphicTest/Packages/Graphics32/GR32_XPThemes.pas

    r450 r522  
    229229constructor TThemeNexus.Create;
    230230begin
    231   FWindowHandle := Classes.AllocateHWnd(WndProc);
     231  FWindowHandle := {$IFDEF FPC}Classes.{$ENDIF}AllocateHWnd(WndProc);
    232232  OpenVisualStyles;
    233233end;
     
    236236begin
    237237  CloseVisualStyles;
    238   Classes.DeallocateHWnd(FWindowHandle);
     238  {$IFDEF FPC}Classes.{$ENDIF}DeallocateHWnd(FWindowHandle);
    239239  inherited;
    240240end;
  • GraphicTest/Packages/Graphics32/Packages/GR32_D2005.dpk

    r450 r522  
    4040  GR32_OrdinalMaps in '..\GR32_OrdinalMaps.pas',
    4141  GR32_VectorMaps in '..\GR32_VectorMaps.pas',
    42   GR32_DrawingEx in '..\GR32_DrawingEx.pas',
    4342  GR32_Filters in '..\GR32_Filters.pas',
    4443  GR32_Layers in '..\GR32_Layers.pas',
  • GraphicTest/Packages/Graphics32/Packages/GR32_D7.dpk

    r450 r522  
    2424{$IMAGEBASE $400000}
    2525{$DESCRIPTION 'Graphics32'}
     26{$RUNONLY}
    2627{$IMPLICITBUILD ON}
    2728
     
    4142  GR32_OrdinalMaps in '..\GR32_OrdinalMaps.pas',
    4243  GR32_VectorMaps in '..\GR32_VectorMaps.pas',
    43   GR32_DrawingEx in '..\GR32_DrawingEx.pas',
    4444  GR32_Filters in '..\GR32_Filters.pas',
    4545  GR32_Layers in '..\GR32_Layers.pas',
     
    5555  GR32_Backends_Generic in '..\GR32_Backends_Generic.pas',
    5656  GR32_Backends_VCL in '..\GR32_Backends_VCL.pas',
    57   GR32_XPThemes in '..\GR32_XPThemes.pas';
     57  GR32_XPThemes in '..\GR32_XPThemes.pas',
     58  GR32_VPR in '..\GR32_VPR.pas',
     59  GR32_Paths in '..\GR32_Paths.pas',
     60  GR32_VectorUtils in '..\GR32_VectorUtils.pas',
     61  GR32_Geometry in '..\GR32_Geometry.pas',
     62  GR32_Text_VCL in '..\GR32_Text_VCL.pas',
     63  GR32_Brushes in '..\GR32_Brushes.pas';
    5864
    5965end.
  • GraphicTest/Packages/Graphics32/Packages/GR32_DSGN_D5.dpk

    r450 r522  
    11package GR32_DSGN_D5;
    22
    3 
    4 
    53{$R *.RES}
    6 
    74{$R '..\GR32_Reg.dcr'}
    8 
    95{$ALIGN ON}
    106{$ASSERTIONS ON}
  • GraphicTest/Packages/Graphics32/Packages/GR32_DSGN_D6.dpk

    r450 r522  
    11package GR32_DSGN_D6;
    22
    3 
    4 
    53{$R *.res}
    6 
    74{$R '..\GR32_Reg.dcr'}
    8 
    95{$ALIGN 8}
    10 
    116{$ASSERTIONS ON}
    12 
    137{$BOOLEVAL OFF}
    14 
    158{$DEBUGINFO ON}
    16 
    179{$EXTENDEDSYNTAX ON}
    18 
    1910{$IMPORTEDDATA ON}
    20 
    2111{$IOCHECKS ON}
    22 
    2312{$LOCALSYMBOLS ON}
    24 
    2513{$LONGSTRINGS ON}
    26 
    2714{$OPENSTRINGS ON}
    28 
    2915{$OPTIMIZATION ON}
    30 
    3116{$OVERFLOWCHECKS OFF}
    32 
    3317{$RANGECHECKS OFF}
    34 
    3518{$REFERENCEINFO ON}
    36 
    3719{$SAFEDIVIDE OFF}
    38 
    3920{$STACKFRAMES OFF}
    40 
    4121{$TYPEDADDRESS OFF}
    42 
    4322{$VARSTRINGCHECKS ON}
    44 
    4523{$WRITEABLECONST OFF}
    46 
    4724{$MINENUMSIZE 1}
    48 
    4925{$IMAGEBASE $400000}
    50 
    5126{$DESCRIPTION 'Graphics32 Design Time Package'}
    52 
    5327{$IMPLICITBUILD ON}
    5428
    55 
    56 
    5729requires
    58 
    5930  designide,
    60 
    6131  vcl,
    62 
    6332  GR32_D6,
    64 
    6533  rtl;
    66 
    67 
    6834
    6935contains
     
    7339  GR32_Dsgn_Misc in '..\GR32_Dsgn_Misc.pas';
    7440
    75 
    76 
    77 
    7841end.
    7942
  • GraphicTest/Packages/Graphics32/Packages/GR32_DSGN_D7.dpk

    r450 r522  
    3737  GR32_Reg in '..\GR32_Reg.pas',
    3838  GR32_Dsgn_Color in '..\GR32_Dsgn_Color.pas',
    39   GR32_Dsgn_Misc in '..\GR32_Dsgn_Misc.pas';
     39  GR32_Dsgn_Misc in '..\GR32_Dsgn_Misc.pas',
     40  GR32_ColorGradients in '..\GR32_ColorGradients.pas',
     41  GR32_ColorPicker in '..\GR32_ColorPicker.pas',
     42  GR32_ColorSwatch in '..\GR32_ColorSwatch.pas';
    4043
    4144end.
  • GraphicTest/Packages/Graphics32/Packages/GR32_DSGN_RS2007.dpk

    r450 r522  
    2626{$DESCRIPTION 'Graphics32 Design Time Package'}
    2727{$DESIGNONLY}
    28 {$IMPLICITBUILD OFF}
     28{$IMPLICITBUILD ON}
    2929
    3030requires
  • GraphicTest/Packages/Graphics32/Packages/GR32_L.pas

    r450 r522  
    33 }
    44
    5 unit GR32_L; 
     5unit GR32_L;
    66
     7{$warn 5023 off : no warning about unused units}
    78interface
    89
    910uses
    10   GR32, GR32_Math, GR32_LowLevel, GR32_System, GR32_Containers, GR32_Blend,
     11  GR32, GR32_Math, GR32_LowLevel, GR32_System, GR32_Containers, GR32_Blend, 
    1112  GR32_Transforms, GR32_OrdinalMaps, GR32_VectorMaps, GR32_DrawingEx,
    1213  GR32_Filters, GR32_Layers, GR32_Image, GR32_ExtImage, GR32_RangeBars,
  • GraphicTest/Packages/Graphics32/Packages/GR32_RS2006.dpk

    r450 r522  
    3131
    3232contains
    33   GR32 in '..\GR32.pas',
    34   GR32_Bindings in '..\GR32_Bindings.pas',
    35   GR32_Math in '..\GR32_Math.pas',
    36   GR32_LowLevel in '..\GR32_LowLevel.pas',
    37   GR32_System in '..\GR32_System.pas',
    38   GR32_Containers in '..\GR32_Containers.pas',
    39   GR32_Blend in '..\GR32_Blend.pas',
    40   GR32_Transforms in '..\GR32_Transforms.pas',
    41   GR32_OrdinalMaps in '..\GR32_OrdinalMaps.pas',
    42   GR32_VectorMaps in '..\GR32_VectorMaps.pas',
    43   GR32_DrawingEx in '..\GR32_DrawingEx.pas',
    44   GR32_Filters in '..\GR32_Filters.pas',
    45   GR32_Layers in '..\GR32_Layers.pas',
    46   GR32_Image in '..\GR32_Image.pas',
    47   GR32_ExtImage in '..\GR32_ExtImage.pas',
    48   GR32_RangeBars in '..\GR32_RangeBars.pas',
    49   GR32_Polygons in '..\GR32_Polygons.pas',
    50   GR32_RepaintOpt in '..\GR32_RepaintOpt.pas',
    51   GR32_MicroTiles in '..\GR32_MicroTiles.pas',
    52   GR32_Rasterizers in '..\GR32_Rasterizers.pas',
    53   GR32_Resamplers in '..\GR32_Resamplers.pas',
    54   GR32_Backends in '..\GR32_Backends.pas',
    55   GR32_Backends_Generic in '..\GR32_Backends_Generic.pas',
    56   GR32_Backends_VCL in '..\GR32_Backends_VCL.pas',
    57   GR32_XPThemes in '..\GR32_XPThemes.pas';
     33  GR32 in '..\..\GR32.pas',
     34  GR32_Backends in '..\..\GR32_Backends.pas',
     35  GR32_Backends_Generic in '..\..\GR32_Backends_Generic.pas',
     36  GR32_Backends_VCL in '..\..\GR32_Backends_VCL.pas',
     37  GR32_Bindings in '..\..\GR32_Bindings.pas',
     38  GR32_Blend in '..\..\GR32_Blend.pas',
     39  GR32_BlendASM in '..\..\GR32_BlendASM.pas',
     40  GR32_BlendMMX in '..\..\GR32_BlendMMX.pas',
     41  GR32_BlendSSE2 in '..\..\GR32_BlendSSE2.pas',
     42  GR32_Brushes in '..\..\GR32_Brushes.pas',
     43  GR32_ColorGradients in '..\..\GR32_ColorGradients.pas',
     44  GR32_ColorPicker in '..\..\GR32_ColorPicker.pas',
     45  GR32_ColorSwatch in '..\..\GR32_ColorSwatch.pas',
     46  GR32_Containers in '..\..\GR32_Containers.pas',
     47  GR32_ExtImage in '..\..\GR32_ExtImage.pas',
     48  GR32_Filters in '..\..\GR32_Filters.pas',
     49  GR32_Gamma in '..\..\GR32_Gamma.pas',
     50  GR32_Geometry in '..\..\GR32_Geometry.pas',
     51  GR32_Image in '..\..\GR32_Image.pas',
     52  GR32_Layers in '..\..\GR32_Layers.pas',
     53  GR32_LowLevel in '..\..\GR32_LowLevel.pas',
     54  GR32_Math in '..\..\GR32_Math.pas',
     55  GR32_MicroTiles in '..\..\GR32_MicroTiles.pas',
     56  GR32_OrdinalMaps in '..\..\GR32_OrdinalMaps.pas',
     57  GR32_Paths in '..\..\GR32_Paths.pas',
     58  GR32_Polygons in '..\..\GR32_Polygons.pas',
     59  GR32_PolygonsAggLite in '..\..\GR32_PolygonsAggLite.pas',
     60  GR32_RangeBars in '..\..\GR32_RangeBars.pas',
     61  GR32_Rasterizers in '..\..\GR32_Rasterizers.pas',
     62  GR32_RepaintOpt in '..\..\GR32_RepaintOpt.pas',
     63  GR32_Resamplers in '..\..\GR32_Resamplers.pas',
     64  GR32_System in '..\..\GR32_System.pas',
     65  GR32_Transforms in '..\..\GR32_Transforms.pas',
     66  GR32_VectorMaps in '..\..\GR32_VectorMaps.pas',
     67  GR32_VectorUtils in '..\..\GR32_VectorUtils.pas',
     68  GR32_VPR in '..\..\GR32_VPR.pas',
     69  GR32_Text_VCL in '..\..\GR32_Text_VCL.pas',
     70  GR32_XPThemes in '..\..\GR32_XPThemes.pas';
    5871
    5972end.
  • GraphicTest/Packages/Graphics32/Packages/GR32_RS2007.dpk

    r450 r522  
    2525{$DESCRIPTION 'Graphics32'}
    2626{$RUNONLY}
    27 {$IMPLICITBUILD OFF}
     27{$IMPLICITBUILD ON}
    2828
    2929requires
     
    3131
    3232contains
    33   GR32 in '..\GR32.pas',
    34   GR32_Bindings in '..\GR32_Bindings.pas',
    35   GR32_Math in '..\GR32_Math.pas',
    36   GR32_Backends in '..\GR32_Backends.pas',
    37   GR32_Backends_Generic in '..\GR32_Backends_Generic.pas',
    38   GR32_Backends_VCL in '..\GR32_Backends_VCL.pas',
    39   GR32_LowLevel in '..\GR32_LowLevel.pas',
    40   GR32_System in '..\GR32_System.pas',
    41   GR32_Containers in '..\GR32_Containers.pas',
    42   GR32_Blend in '..\GR32_Blend.pas',
    43   GR32_Transforms in '..\GR32_Transforms.pas',
    44   GR32_OrdinalMaps in '..\GR32_OrdinalMaps.pas',
    45   GR32_VectorMaps in '..\GR32_VectorMaps.pas',
    46   GR32_DrawingEx in '..\GR32_DrawingEx.pas',
    47   GR32_Filters in '..\GR32_Filters.pas',
    48   GR32_Layers in '..\GR32_Layers.pas',
    49   GR32_Image in '..\GR32_Image.pas',
    50   GR32_ExtImage in '..\GR32_ExtImage.pas',
    51   GR32_RangeBars in '..\GR32_RangeBars.pas',
    52   GR32_Polygons in '..\GR32_Polygons.pas',
    53   GR32_RepaintOpt in '..\GR32_RepaintOpt.pas',
    54   GR32_MicroTiles in '..\GR32_MicroTiles.pas',
    55   GR32_Rasterizers in '..\GR32_Rasterizers.pas',
    56   GR32_Resamplers in '..\GR32_Resamplers.pas',
    57   GR32_XPThemes in '..\GR32_XPThemes.pas';
     33  GR32 in '..\..\GR32.pas',
     34  GR32_Backends in '..\..\GR32_Backends.pas',
     35  GR32_Backends_Generic in '..\..\GR32_Backends_Generic.pas',
     36  GR32_Backends_VCL in '..\..\GR32_Backends_VCL.pas',
     37  GR32_Bindings in '..\..\GR32_Bindings.pas',
     38  GR32_Blend in '..\..\GR32_Blend.pas',
     39  GR32_BlendASM in '..\..\GR32_BlendASM.pas',
     40  GR32_BlendMMX in '..\..\GR32_BlendMMX.pas',
     41  GR32_BlendSSE2 in '..\..\GR32_BlendSSE2.pas',
     42  GR32_Brushes in '..\..\GR32_Brushes.pas',
     43  GR32_ColorGradients in '..\..\GR32_ColorGradients.pas',
     44  GR32_ColorPicker in '..\..\GR32_ColorPicker.pas',
     45  GR32_ColorSwatch in '..\..\GR32_ColorSwatch.pas',
     46  GR32_Containers in '..\..\GR32_Containers.pas',
     47  GR32_ExtImage in '..\..\GR32_ExtImage.pas',
     48  GR32_Filters in '..\..\GR32_Filters.pas',
     49  GR32_Gamma in '..\..\GR32_Gamma.pas',
     50  GR32_Geometry in '..\..\GR32_Geometry.pas',
     51  GR32_Image in '..\..\GR32_Image.pas',
     52  GR32_Layers in '..\..\GR32_Layers.pas',
     53  GR32_LowLevel in '..\..\GR32_LowLevel.pas',
     54  GR32_Math in '..\..\GR32_Math.pas',
     55  GR32_MicroTiles in '..\..\GR32_MicroTiles.pas',
     56  GR32_OrdinalMaps in '..\..\GR32_OrdinalMaps.pas',
     57  GR32_Paths in '..\..\GR32_Paths.pas',
     58  GR32_Polygons in '..\..\GR32_Polygons.pas',
     59  GR32_PolygonsAggLite in '..\..\GR32_PolygonsAggLite.pas',
     60  GR32_RangeBars in '..\..\GR32_RangeBars.pas',
     61  GR32_Rasterizers in '..\..\GR32_Rasterizers.pas',
     62  GR32_RepaintOpt in '..\..\GR32_RepaintOpt.pas',
     63  GR32_Resamplers in '..\..\GR32_Resamplers.pas',
     64  GR32_System in '..\..\GR32_System.pas',
     65  GR32_Transforms in '..\..\GR32_Transforms.pas',
     66  GR32_VectorMaps in '..\..\GR32_VectorMaps.pas',
     67  GR32_VectorUtils in '..\..\GR32_VectorUtils.pas',
     68  GR32_VPR in '..\..\GR32_VPR.pas',
     69  GR32_Text_VCL in '..\..\GR32_Text_VCL.pas',
     70  GR32_XPThemes in '..\..\GR32_XPThemes.pas';
    5871
    5972end.
  • GraphicTest/Packages/Graphics32/Packages/GR32_RS2009.dpk

    r450 r522  
    2525{$DESCRIPTION 'Graphics32'}
    2626{$RUNONLY}
    27 {$IMPLICITBUILD OFF}
     27{$IMPLICITBUILD ON}
    2828
    2929requires
     
    3131
    3232contains
    33   GR32 in '..\GR32.pas',
    34   GR32_Bindings in '..\GR32_Bindings.pas', 
    35   GR32_Math in '..\GR32_Math.pas',
    36   GR32_Backends in '..\GR32_Backends.pas',
    37   GR32_Backends_Generic in '..\GR32_Backends_Generic.pas',
    38   GR32_Backends_VCL in '..\GR32_Backends_VCL.pas',
    39   GR32_LowLevel in '..\GR32_LowLevel.pas',
    40   GR32_System in '..\GR32_System.pas',
    41   GR32_Containers in '..\GR32_Containers.pas',
    42   GR32_Blend in '..\GR32_Blend.pas',
    43   GR32_Transforms in '..\GR32_Transforms.pas',
    44   GR32_OrdinalMaps in '..\GR32_OrdinalMaps.pas',
    45   GR32_VectorMaps in '..\GR32_VectorMaps.pas',
    46   GR32_DrawingEx in '..\GR32_DrawingEx.pas',
    47   GR32_Filters in '..\GR32_Filters.pas',
    48   GR32_Layers in '..\GR32_Layers.pas',
    49   GR32_Image in '..\GR32_Image.pas',
    50   GR32_ExtImage in '..\GR32_ExtImage.pas',
    51   GR32_RangeBars in '..\GR32_RangeBars.pas',
    52   GR32_Polygons in '..\GR32_Polygons.pas',
    53   GR32_RepaintOpt in '..\GR32_RepaintOpt.pas',
    54   GR32_MicroTiles in '..\GR32_MicroTiles.pas',
    55   GR32_Rasterizers in '..\GR32_Rasterizers.pas',
    56   GR32_Resamplers in '..\GR32_Resamplers.pas',
    57   GR32_XPThemes in '..\GR32_XPThemes.pas';
     33  GR32 in '..\..\GR32.pas',
     34  GR32_Backends in '..\..\GR32_Backends.pas',
     35  GR32_Backends_Generic in '..\..\GR32_Backends_Generic.pas',
     36  GR32_Backends_VCL in '..\..\GR32_Backends_VCL.pas',
     37  GR32_Bindings in '..\..\GR32_Bindings.pas',
     38  GR32_Blend in '..\..\GR32_Blend.pas',
     39  GR32_BlendASM in '..\..\GR32_BlendASM.pas',
     40  GR32_BlendMMX in '..\..\GR32_BlendMMX.pas',
     41  GR32_BlendSSE2 in '..\..\GR32_BlendSSE2.pas',
     42  GR32_Brushes in '..\..\GR32_Brushes.pas',
     43  GR32_ColorGradients in '..\..\GR32_ColorGradients.pas',
     44  GR32_ColorPicker in '..\..\GR32_ColorPicker.pas',
     45  GR32_ColorSwatch in '..\..\GR32_ColorSwatch.pas',
     46  GR32_Containers in '..\..\GR32_Containers.pas',
     47  GR32_ExtImage in '..\..\GR32_ExtImage.pas',
     48  GR32_Filters in '..\..\GR32_Filters.pas',
     49  GR32_Gamma in '..\..\GR32_Gamma.pas',
     50  GR32_Geometry in '..\..\GR32_Geometry.pas',
     51  GR32_Image in '..\..\GR32_Image.pas',
     52  GR32_Layers in '..\..\GR32_Layers.pas',
     53  GR32_LowLevel in '..\..\GR32_LowLevel.pas',
     54  GR32_Math in '..\..\GR32_Math.pas',
     55  GR32_MicroTiles in '..\..\GR32_MicroTiles.pas',
     56  GR32_OrdinalMaps in '..\..\GR32_OrdinalMaps.pas',
     57  GR32_Paths in '..\..\GR32_Paths.pas',
     58  GR32_Polygons in '..\..\GR32_Polygons.pas',
     59  GR32_PolygonsAggLite in '..\..\GR32_PolygonsAggLite.pas',
     60  GR32_RangeBars in '..\..\GR32_RangeBars.pas',
     61  GR32_Rasterizers in '..\..\GR32_Rasterizers.pas',
     62  GR32_RepaintOpt in '..\..\GR32_RepaintOpt.pas',
     63  GR32_Resamplers in '..\..\GR32_Resamplers.pas',
     64  GR32_System in '..\..\GR32_System.pas',
     65  GR32_Transforms in '..\..\GR32_Transforms.pas',
     66  GR32_VectorMaps in '..\..\GR32_VectorMaps.pas',
     67  GR32_VectorUtils in '..\..\GR32_VectorUtils.pas',
     68  GR32_VPR in '..\..\GR32_VPR.pas',
     69  GR32_Text_VCL in '..\..\GR32_Text_VCL.pas',
     70  GR32_XPThemes in '..\..\GR32_XPThemes.pas';
    5871
    5972end.
  • GraphicTest/UMainForm.lfm

    r472 r522  
    11object MainForm: TMainForm
    2   Left = 561
    3   Height = 577
    4   Top = 310
    5   Width = 998
     2  Left = 63
     3  Height = 721
     4  Top = 49
     5  Width = 1248
    66  Caption = 'Graphic test'
    7   ClientHeight = 548
    8   ClientWidth = 998
     7  ClientHeight = 696
     8  ClientWidth = 1248
     9  DesignTimePPI = 120
    910  Menu = MainMenu1
    1011  OnClose = FormClose
     
    1213  OnDestroy = FormDestroy
    1314  OnShow = FormShow
    14   LCLVersion = '1.5'
     15  LCLVersion = '2.0.0.4'
    1516  object PageControl1: TPageControl
    16     Left = 600
    17     Height = 548
     17    Left = 750
     18    Height = 696
    1819    Top = 0
    19     Width = 398
     20    Width = 498
    2021    ActivePage = TabSheet1
    2122    Align = alRight
     23    ParentFont = False
    2224    TabIndex = 0
    2325    TabOrder = 0
    2426    object TabSheet1: TTabSheet
    2527      Caption = 'Description'
    26       ClientHeight = 505
    27       ClientWidth = 392
     28      ClientHeight = 663
     29      ClientWidth = 490
     30      ParentFont = False
    2831      object Memo1: TMemo
    2932        Left = 0
    30         Height = 505
     33        Height = 663
    3134        Top = 0
    32         Width = 392
     35        Width = 490
    3336        Align = alClient
     37        ParentFont = False
    3438        ReadOnly = True
    3539        ScrollBars = ssAutoBoth
     
    4145      ClientHeight = 505
    4246      ClientWidth = 392
     47      ParentFont = False
    4348      inline SynMemo1: TSynMemo
    4449        Cursor = crIBeam
     
    4853        Width = 394
    4954        Align = alClient
    50         Font.Height = -13
     55        Font.Height = -16
    5156        Font.Name = 'Courier New'
    5257        Font.Pitch = fpFixed
     
    5560        ParentFont = False
    5661        TabOrder = 0
    57         Gutter.Width = 57
     62        Gutter.Width = 72
    5863        Gutter.MouseActions = <>
    5964        Highlighter = SynPasSyn1
     
    492497        inline SynLeftGutterPartList1: TSynGutterPartList
    493498          object SynGutterMarks1: TSynGutterMarks
    494             Width = 24
     499            Width = 30
    495500            MouseActions = <>
    496501          end
    497502          object SynGutterLineNumber1: TSynGutterLineNumber
    498             Width = 17
     503            Width = 21
    499504            MouseActions = <>
    500505            MarkupInfo.Background = clBtnFace
     
    506511          end
    507512          object SynGutterChanges1: TSynGutterChanges
    508             Width = 4
     513            Width = 5
    509514            MouseActions = <>
    510515            ModifiedColor = 59900
     
    512517          end
    513518          object SynGutterSeparator1: TSynGutterSeparator
    514             Width = 2
     519            Width = 3
    515520            MouseActions = <>
    516521            MarkupInfo.Background = clWhite
     
    518523          end
    519524          object SynGutterCodeFolding1: TSynGutterCodeFolding
     525            Width = 13
    520526            MouseActions = <>
    521527            MarkupInfo.Background = clNone
     
    530536  object Panel1: TPanel
    531537    Left = 0
    532     Height = 548
     538    Height = 696
    533539    Top = 0
    534     Width = 595
     540    Width = 744
    535541    Align = alClient
    536542    BevelOuter = bvNone
    537     ClientHeight = 548
    538     ClientWidth = 595
     543    ClientHeight = 696
     544    ClientWidth = 744
     545    ParentFont = False
    539546    TabOrder = 1
    540547    object ListViewMethods: TListView
    541       Left = 4
    542       Height = 423
    543       Top = 4
    544       Width = 589
     548      Left = 5
     549      Height = 540
     550      Top = 5
     551      Width = 737
    545552      Anchors = [akTop, akLeft, akRight, akBottom]
    546553      Columns = <     
    547554        item
    548555          Caption = 'Method'
    549           Width = 200
     556          Width = 250
    550557        end     
    551558        item
    552559          Caption = 'FPS'
    553           Width = 75
     560          Width = 94
    554561        end     
    555562        item
    556563          Caption = 'Duration [ms]'
    557           Width = 80
     564          Width = 100
    558565        end     
    559566        item
    560567          Caption = 'Draw FPS'
    561           Width = 75
     568          Width = 94
    562569        end     
    563570        item
    564571          Caption = 'Draw duration [ms]'
    565           Width = 80
     572          Width = 100
    566573        end     
    567574        item
    568575          Caption = 'Step FPS'
    569           Width = 75
     576          Width = 94
    570577        end     
    571578        item
    572579          Caption = 'Step duration [ms]'
    573           Width = 80
     580          Width = 100
    574581        end>
    575582      OwnerData = True
     583      ParentFont = False
    576584      PopupMenu = PopupMenu1
    577585      ReadOnly = True
     
    583591    end
    584592    object ButtonSingleTest: TButton
    585       Left = 232
    586       Height = 32
    587       Top = 468
    588       Width = 160
     593      Left = 290
     594      Height = 40
     595      Top = 596
     596      Width = 200
    589597      Action = ATestOneMethod
    590598      Anchors = [akLeft, akBottom]
     599      ParentFont = False
    591600      TabOrder = 1
    592601    end
    593602    object ButtonBenchmark: TButton
    594       Left = 232
    595       Height = 33
    596       Top = 432
    597       Width = 160
     603      Left = 290
     604      Height = 41
     605      Top = 551
     606      Width = 200
    598607      Action = ATestAllMethods
    599608      Anchors = [akLeft, akBottom]
     609      ParentFont = False
    600610      TabOrder = 2
    601611    end
    602612    object FloatSpinEdit1: TFloatSpinEdit
    603       Left = 152
    604       Height = 35
    605       Top = 472
    606       Width = 58
    607       Anchors = [akLeft, akBottom]
    608       Increment = 1
    609       MaxValue = 100
     613      Left = 190
     614      Height = 28
     615      Top = 617
     616      Width = 72
     617      Anchors = [akLeft, akBottom]
    610618      MinValue = 0
     619      ParentFont = False
    611620      TabOrder = 3
    612621      Value = 1
    613622    end
    614623    object ButtonStop: TButton
    615       Left = 312
    616       Height = 33
    617       Top = 502
    618       Width = 75
     624      Left = 390
     625      Height = 41
     626      Top = 639
     627      Width = 94
    619628      Action = ATestStop
    620629      Anchors = [akLeft, akBottom]
     630      ParentFont = False
    621631      TabOrder = 4
    622632    end
    623633    object Label1: TLabel
    624       Left = 8
    625       Height = 25
    626       Top = 473
    627       Width = 131
     634      Left = 10
     635      Height = 20
     636      Top = 614
     637      Width = 93
    628638      Anchors = [akLeft, akBottom]
    629639      Caption = 'Step duration:'
    630640      ParentColor = False
     641      ParentFont = False
    631642    end
    632643    object Label2: TLabel
    633       Left = 216
    634       Height = 25
    635       Top = 473
    636       Width = 9
     644      Left = 270
     645      Height = 20
     646      Top = 614
     647      Width = 6
    637648      Anchors = [akLeft, akBottom]
    638649      Caption = 's'
    639650      ParentColor = False
     651      ParentFont = False
    640652    end
    641653    object SpinEditWidth: TSpinEdit
    642       Left = 72
    643       Height = 35
    644       Top = 432
    645       Width = 58
     654      Left = 90
     655      Height = 28
     656      Top = 567
     657      Width = 72
    646658      Anchors = [akLeft, akBottom]
    647659      MaxValue = 1000
    648660      OnChange = SpinEditWidthChange
     661      ParentFont = False
    649662      TabOrder = 5
    650663      Value = 320
    651664    end
    652665    object SpinEditHeight: TSpinEdit
    653       Left = 152
    654       Height = 35
    655       Top = 432
    656       Width = 58
     666      Left = 190
     667      Height = 28
     668      Top = 567
     669      Width = 72
    657670      Anchors = [akLeft, akBottom]
    658671      MaxValue = 1000
    659672      OnChange = SpinEditHeightChange
     673      ParentFont = False
    660674      TabOrder = 6
    661675      Value = 240
    662676    end
    663677    object Label3: TLabel
    664       Left = 8
    665       Height = 25
    666       Top = 436
    667       Width = 42
     678      Left = 10
     679      Height = 20
     680      Top = 567
     681      Width = 30
    668682      Anchors = [akLeft, akBottom]
    669683      Caption = 'Size:'
    670684      ParentColor = False
     685      ParentFont = False
    671686    end
    672687    object Label4: TLabel
    673       Left = 136
    674       Height = 25
    675       Top = 442
    676       Width = 10
     688      Left = 170
     689      Height = 20
     690      Top = 575
     691      Width = 7
    677692      Anchors = [akLeft, akBottom]
    678693      Caption = 'x'
    679694      ParentColor = False
     695      ParentFont = False
    680696    end
    681697    object CheckBoxDoubleBuffered: TCheckBox
    682       Left = 400
    683       Height = 27
    684       Top = 436
    685       Width = 174
     698      Left = 500
     699      Height = 24
     700      Top = 566
     701      Width = 134
    686702      Anchors = [akLeft, akBottom]
    687703      Caption = 'Double buffered'
    688704      OnChange = CheckBoxDoubleBufferedChange
     705      ParentFont = False
    689706      TabOrder = 7
    690707    end
    691708    object CheckBoxEraseBackground: TCheckBox
    692       Left = 400
    693       Height = 27
    694       Top = 468
    695       Width = 188
     709      Left = 500
     710      Height = 24
     711      Top = 606
     712      Width = 142
    696713      Anchors = [akLeft, akBottom]
    697714      Caption = 'Erase background'
    698715      OnChange = CheckBoxEraseBackgroundChange
     716      ParentFont = False
    699717      TabOrder = 8
    700718    end
    701719    object CheckBoxOpaque: TCheckBox
    702       Left = 400
    703       Height = 27
    704       Top = 503
    705       Width = 96
     720      Left = 500
     721      Height = 24
     722      Top = 650
     723      Width = 77
    706724      Anchors = [akLeft, akBottom]
    707725      Caption = 'Opaque'
    708726      OnChange = CheckBoxOpaqueChange
     727      ParentFont = False
    709728      TabOrder = 9
    710729    end
    711730    object Label5: TLabel
    712       Left = 8
    713       Height = 25
    714       Top = 510
    715       Width = 118
     731      Left = 10
     732      Height = 20
     733      Top = 660
     734      Width = 83
    716735      Anchors = [akLeft, akBottom]
    717736      Caption = 'Pixel format:'
    718737      ParentColor = False
     738      ParentFont = False
    719739    end
    720740    object ComboBoxPixelFormat: TComboBox
    721       Left = 136
    722       Height = 37
    723       Top = 508
    724       Width = 144
    725       Anchors = [akLeft, akBottom]
    726       ItemHeight = 0
     741      Left = 170
     742      Height = 28
     743      Top = 664
     744      Width = 180
     745      Anchors = [akLeft, akBottom]
     746      ItemHeight = 20
    727747      OnChange = ComboBoxPixelFormatChange
     748      ParentFont = False
    728749      Style = csDropDownList
    729750      TabOrder = 10
     
    731752  end
    732753  object Splitter1: TSplitter
    733     Left = 595
    734     Height = 548
     754    Left = 744
     755    Height = 696
    735756    Top = 0
    736     Width = 5
     757    Width = 6
    737758    Align = alRight
    738759    ResizeAnchor = akRight
     
    742763    CompilerMode = pcmDelphi
    743764    NestedComments = False
    744     left = 649
    745     top = 86
     765    left = 811
     766    top = 108
    746767  end
    747768  object TimerUpdateList: TTimer
    748769    Interval = 500
    749770    OnTimer = TimerUpdateListTimer
    750     left = 266
    751     top = 164
     771    left = 333
     772    top = 205
    752773  end
    753774  object ActionList1: TActionList
    754     left = 104
    755     top = 168
     775    left = 130
     776    top = 210
    756777    object AExportAsWikiText: TAction
    757778      Caption = 'Export as Wiki text'
     
    788809  end
    789810  object MainMenu1: TMainMenu
    790     left = 160
    791     top = 80
     811    left = 200
     812    top = 100
    792813    object MenuItem1: TMenuItem
    793814      Caption = 'General'
     
    820841  object SaveDialog1: TSaveDialog
    821842    DefaultExt = '.txt'
    822     left = 308
    823     top = 76
     843    left = 385
     844    top = 95
    824845  end
    825846  object PopupMenu1: TPopupMenu
    826     left = 401
    827     top = 176
     847    left = 501
     848    top = 220
    828849    object MenuItem9: TMenuItem
    829850      Action = ATestOneMethod
     
    838859  object TimerUpdateSettings: TTimer
    839860    OnTimer = TimerUpdateSettingsTimer
    840     left = 272
    841     top = 264
     861    left = 340
     862    top = 330
    842863  end
    843864end
  • GraphicTest/UMainForm.pas

    r521 r522  
    121121  UCanvasPixelsUpdateLock, UBGRABitmapPaintBox, UBitmapRawImageDataPaintBox,
    122122  UBitmapRawImageData, UBitmapRawImageDataMove, UDummyMethod, UOpenGLMethod,
    123   UOpenGLPBOMethod, UGraphics32Method;
     123  UOpenGLPBOMethod{$IFDEF GRAPHICS32}, UGraphics32Method{$ENDIF};
    124124
    125125{ TMainForm }
Note: See TracChangeset for help on using the changeset viewer.