GLScene/Externals/Graphics32/Source/GR32.pas

unit GR32;

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1 or LGPL 2.1 with linking exception
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * Alternatively, the contents of this file may be used under the terms of the
 * Free Pascal modified version of the GNU Lesser General Public License
 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
 * of this license are applicable instead of those above.
 * Please see the file LICENSE.txt for additional information concerning this
 * license.
 *
 * The Original Code is Graphics32
 *
 * The Initial Developer of the Original Code is
 * Alex A. Denisov
 *
 * Portions created by the Initial Developer are Copyright (C) 2000-2009
 * the Initial Developer. All Rights Reserved.
 *
 * ***** END LICENSE BLOCK ***** *)

interface

{$include GR32.inc}

uses
  Math,
{$IFDEF FPC}
  LCLIntf, LCLType, Types,
{$ELSE}
  System.UITypes,
  System.Types,
  System.SyncObjs,
{$ENDIF}
{$if defined(FRAMEWORK_VCL)}
  {$if not defined(PLATFORM_INDEPENDENT)}
  WinApi.Windows,
  {$ifend}
  VCL.Graphics,
  VCL.Controls, // Required by DrawTo(TControlCanvas)
{$elseif defined(FRAMEWORK_FMX)}
  {$if defined(MSWINDOWS) and not defined(PLATFORM_INDEPENDENT)}
  WinApi.Windows,
  {$ifend}
  FMX.Graphics,
  FMX.Controls,
{$elseif defined(FRAMEWORK_LCL)}
  Graphics,
  Controls,
{$ifend}
  Classes,
  SysUtils,
  GR32_Bindings;

{$if defined(FRAMEWORK_FMX)}
type
  TControlCanvas = TCanvas;
{$ifend}

{ Version Control }
const
  Graphics32Version = '3.0';

{ 32-bit Color }
type
  PColor32 = ^TColor32;
  TColor32 = type Cardinal;

  PColor32Array = ^TColor32Array;
  TColor32Array = array [0..0] of TColor32;
  TArrayOfColor32 = array of TColor32;

{$IFNDEF RGBA_FORMAT}
  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
{$ELSE}
  TColor32Component = (ccRed, ccGreen, ccBlue, ccAlpha);
{$ENDIF}
  TColor32Components = set of TColor32Component;

  PColor32Entry = ^TColor32Entry;
  TColor32Entry = packed record
    case Integer of
{$IFNDEF RGBA_FORMAT}
      0: (B, G, R, A: Byte);
{$ELSE}
      0: (R, G, B, A: Byte);
{$ENDIF}
      1: (ARGB: TColor32);
      2: (Planes: array[0..3] of Byte);
      3: (Components: array[TColor32Component] of Byte);
  end;

  PColor32EntryArray = ^TColor32EntryArray;
  TColor32EntryArray = array [0..0] of TColor32Entry;
  TArrayOfColor32Entry = array of TColor32Entry;

  PPalette32 = ^TPalette32;
  TPalette32 = array [Byte] of TColor32;

const
  // Some predefined color constants
  clNone32                = TColor32($00000000);
  clBlack32               = TColor32({$IFNDEF RGBA_FORMAT} $FF000000 {$ELSE} $FF000000 {$ENDIF});
  clDimGray32             = TColor32({$IFNDEF RGBA_FORMAT} $FF3F3F3F {$ELSE} $FF3F3F3F {$ENDIF});
  clGray32                = TColor32({$IFNDEF RGBA_FORMAT} $FF7F7F7F {$ELSE} $FF7F7F7F {$ENDIF});
  clLightGray32           = TColor32({$IFNDEF RGBA_FORMAT} $FFBFBFBF {$ELSE} $FFBFBFBF {$ENDIF});
  clWhite32               = TColor32({$IFNDEF RGBA_FORMAT} $FFFFFFFF {$ELSE} $FFFFFFFF {$ENDIF});
  clMaroon32              = TColor32({$IFNDEF RGBA_FORMAT} $FF7F0000 {$ELSE} $FF00007F {$ENDIF});
  clGreen32               = TColor32({$IFNDEF RGBA_FORMAT} $FF007F00 {$ELSE} $FF007F00 {$ENDIF});
  clOlive32               = TColor32({$IFNDEF RGBA_FORMAT} $FF7F7F00 {$ELSE} $FF007F7F {$ENDIF});
  clNavy32                = TColor32({$IFNDEF RGBA_FORMAT} $FF00007F {$ELSE} $FF7F0000 {$ENDIF});
  clPurple32              = TColor32({$IFNDEF RGBA_FORMAT} $FF7F007F {$ELSE} $FF7F007F {$ENDIF});
  clTeal32                = TColor32({$IFNDEF RGBA_FORMAT} $FF007F7F {$ELSE} $FF7F7F00 {$ENDIF});
  clRed32                 = TColor32({$IFNDEF RGBA_FORMAT} $FFFF0000 {$ELSE} $FF0000FF {$ENDIF});
  clLime32                = TColor32({$IFNDEF RGBA_FORMAT} $FF00FF00 {$ELSE} $FF00FF00 {$ENDIF});
  clYellow32              = TColor32({$IFNDEF RGBA_FORMAT} $FFFFFF00 {$ELSE} $FF00FFFF {$ENDIF});
  clBlue32                = TColor32({$IFNDEF RGBA_FORMAT} $FF0000FF {$ELSE} $FFFF0000 {$ENDIF});
  clFuchsia32             = TColor32({$IFNDEF RGBA_FORMAT} $FFFF00FF {$ELSE} $FFFF00FF {$ENDIF});
  clAqua32                = TColor32({$IFNDEF RGBA_FORMAT} $FF00FFFF {$ELSE} $FFFFFF00 {$ENDIF});

  clAliceBlue32           = TColor32({$IFNDEF RGBA_FORMAT} $FFF0F8FF {$ELSE} $FFFFF8F0 {$ENDIF});
  clAntiqueWhite32        = TColor32({$IFNDEF RGBA_FORMAT} $FFFAEBD7 {$ELSE} $FFD7EBFA {$ENDIF});
  clAquamarine32          = TColor32({$IFNDEF RGBA_FORMAT} $FF7FFFD4 {$ELSE} $FFD4FF7F {$ENDIF});
  clAzure32               = TColor32({$IFNDEF RGBA_FORMAT} $FFF0FFFF {$ELSE} $FFFFFFF0 {$ENDIF});
  clBeige32               = TColor32({$IFNDEF RGBA_FORMAT} $FFF5F5DC {$ELSE} $FFDCF5F5 {$ENDIF});
  clBisque32              = TColor32({$IFNDEF RGBA_FORMAT} $FFFFE4C4 {$ELSE} $FFC4E4FF {$ENDIF});
  clBlancheDalmond32      = TColor32({$IFNDEF RGBA_FORMAT} $FFFFEBCD {$ELSE} $FFCDEBFF {$ENDIF});
  clBlueViolet32          = TColor32({$IFNDEF RGBA_FORMAT} $FF8A2BE2 {$ELSE} $FFE22B8A {$ENDIF});
  clBrown32               = TColor32({$IFNDEF RGBA_FORMAT} $FFA52A2A {$ELSE} $FF2A2AA5 {$ENDIF});
  clBurlyWood32           = TColor32({$IFNDEF RGBA_FORMAT} $FFDEB887 {$ELSE} $FF87B8DE {$ENDIF});
  clCadetblue32           = TColor32({$IFNDEF RGBA_FORMAT} $FF5F9EA0 {$ELSE} $FFA09E5F {$ENDIF});
  clChartReuse32          = TColor32({$IFNDEF RGBA_FORMAT} $FF7FFF00 {$ELSE} $FF00FF7F {$ENDIF});
  clChocolate32           = TColor32({$IFNDEF RGBA_FORMAT} $FFD2691E {$ELSE} $FF1E69D2 {$ENDIF});
  clCoral32               = TColor32({$IFNDEF RGBA_FORMAT} $FFFF7F50 {$ELSE} $FF507FFF {$ENDIF});
  clCornFlowerBlue32      = TColor32({$IFNDEF RGBA_FORMAT} $FF6495ED {$ELSE} $FFED9564 {$ENDIF});
  clCornSilk32            = TColor32({$IFNDEF RGBA_FORMAT} $FFFFF8DC {$ELSE} $FFDCF8FF {$ENDIF});
  clCrimson32             = TColor32({$IFNDEF RGBA_FORMAT} $FFDC143C {$ELSE} $FF3C14DC {$ENDIF});
  clDarkBlue32            = TColor32({$IFNDEF RGBA_FORMAT} $FF00008B {$ELSE} $FF8B0000 {$ENDIF});
  clDarkCyan32            = TColor32({$IFNDEF RGBA_FORMAT} $FF008B8B {$ELSE} $FF8B8B00 {$ENDIF});
  clDarkGoldenRod32       = TColor32({$IFNDEF RGBA_FORMAT} $FFB8860B {$ELSE} $FF0B86B8 {$ENDIF});
  clDarkGray32            = TColor32({$IFNDEF RGBA_FORMAT} $FFA9A9A9 {$ELSE} $FFA9A9A9 {$ENDIF});
  clDarkGreen32           = TColor32({$IFNDEF RGBA_FORMAT} $FF006400 {$ELSE} $FF006400 {$ENDIF});
  clDarkGrey32            = TColor32({$IFNDEF RGBA_FORMAT} $FFA9A9A9 {$ELSE} $FFA9A9A9 {$ENDIF});
  clDarkKhaki32           = TColor32({$IFNDEF RGBA_FORMAT} $FFBDB76B {$ELSE} $FF6BB7BD {$ENDIF});
  clDarkMagenta32         = TColor32({$IFNDEF RGBA_FORMAT} $FF8B008B {$ELSE} $FF8B008B {$ENDIF});
  clDarkOliveGreen32      = TColor32({$IFNDEF RGBA_FORMAT} $FF556B2F {$ELSE} $FF2F6B55 {$ENDIF});
  clDarkOrange32          = TColor32({$IFNDEF RGBA_FORMAT} $FFFF8C00 {$ELSE} $FF008CFF {$ENDIF});
  clDarkOrchid32          = TColor32({$IFNDEF RGBA_FORMAT} $FF9932CC {$ELSE} $FFCC3299 {$ENDIF});
  clDarkRed32             = TColor32({$IFNDEF RGBA_FORMAT} $FF8B0000 {$ELSE} $FF00008B {$ENDIF});
  clDarkSalmon32          = TColor32({$IFNDEF RGBA_FORMAT} $FFE9967A {$ELSE} $FF7A96E9 {$ENDIF});
  clDarkSeaGreen32        = TColor32({$IFNDEF RGBA_FORMAT} $FF8FBC8F {$ELSE} $FF8FBC8F {$ENDIF});
  clDarkSlateBlue32       = TColor32({$IFNDEF RGBA_FORMAT} $FF483D8B {$ELSE} $FF8B3D48 {$ENDIF});
  clDarkSlateGray32       = TColor32({$IFNDEF RGBA_FORMAT} $FF2F4F4F {$ELSE} $FF4F4F2F {$ENDIF});
  clDarkSlateGrey32       = TColor32({$IFNDEF RGBA_FORMAT} $FF2F4F4F {$ELSE} $FF4F4F2F {$ENDIF});
  clDarkTurquoise32       = TColor32({$IFNDEF RGBA_FORMAT} $FF00CED1 {$ELSE} $FFD1CE00 {$ENDIF});
  clDarkViolet32          = TColor32({$IFNDEF RGBA_FORMAT} $FF9400D3 {$ELSE} $FFD30094 {$ENDIF});
  clDeepPink32            = TColor32({$IFNDEF RGBA_FORMAT} $FFFF1493 {$ELSE} $FF9314FF {$ENDIF});
  clDeepSkyBlue32         = TColor32({$IFNDEF RGBA_FORMAT} $FF00BFFF {$ELSE} $FFFFBF00 {$ENDIF});
  clDodgerBlue32          = TColor32({$IFNDEF RGBA_FORMAT} $FF1E90FF {$ELSE} $FFFF901E {$ENDIF});
  clFireBrick32           = TColor32({$IFNDEF RGBA_FORMAT} $FFB22222 {$ELSE} $FF2222B2 {$ENDIF});
  clFloralWhite32         = TColor32({$IFNDEF RGBA_FORMAT} $FFFFFAF0 {$ELSE} $FFF0FAFF {$ENDIF});
  clGainsBoro32           = TColor32({$IFNDEF RGBA_FORMAT} $FFDCDCDC {$ELSE} $FFDCDCDC {$ENDIF});
  clGhostWhite32          = TColor32({$IFNDEF RGBA_FORMAT} $FFF8F8FF {$ELSE} $FFFFF8F8 {$ENDIF});
  clGold32                = TColor32({$IFNDEF RGBA_FORMAT} $FFFFD700 {$ELSE} $FF00D7FF {$ENDIF});
  clGoldenRod32           = TColor32({$IFNDEF RGBA_FORMAT} $FFDAA520 {$ELSE} $FF20A5DA {$ENDIF});
  clGreenYellow32         = TColor32({$IFNDEF RGBA_FORMAT} $FFADFF2F {$ELSE} $FF2FFFAD {$ENDIF});
  clGrey32                = TColor32({$IFNDEF RGBA_FORMAT} $FF808080 {$ELSE} $FF808080 {$ENDIF});
  clHoneyDew32            = TColor32({$IFNDEF RGBA_FORMAT} $FFF0FFF0 {$ELSE} $FFF0FFF0 {$ENDIF});
  clHotPink32             = TColor32({$IFNDEF RGBA_FORMAT} $FFFF69B4 {$ELSE} $FFB469FF {$ENDIF});
  clIndianRed32           = TColor32({$IFNDEF RGBA_FORMAT} $FFCD5C5C {$ELSE} $FF5C5CCD {$ENDIF});
  clIndigo32              = TColor32({$IFNDEF RGBA_FORMAT} $FF4B0082 {$ELSE} $FF82004B {$ENDIF});
  clIvory32               = TColor32({$IFNDEF RGBA_FORMAT} $FFFFFFF0 {$ELSE} $FFF0FFFF {$ENDIF});
  clKhaki32               = TColor32({$IFNDEF RGBA_FORMAT} $FFF0E68C {$ELSE} $FF8CE6F0 {$ENDIF});
  clLavender32            = TColor32({$IFNDEF RGBA_FORMAT} $FFE6E6FA {$ELSE} $FFFAE6E6 {$ENDIF});
  clLavenderBlush32       = TColor32({$IFNDEF RGBA_FORMAT} $FFFFF0F5 {$ELSE} $FFF5F0FF {$ENDIF});
  clLawnGreen32           = TColor32({$IFNDEF RGBA_FORMAT} $FF7CFC00 {$ELSE} $FF00FC7C {$ENDIF});
  clLemonChiffon32        = TColor32({$IFNDEF RGBA_FORMAT} $FFFFFACD {$ELSE} $FFCDFAFF {$ENDIF});
  clLightBlue32           = TColor32({$IFNDEF RGBA_FORMAT} $FFADD8E6 {$ELSE} $FFE6D8AD {$ENDIF});
  clLightCoral32          = TColor32({$IFNDEF RGBA_FORMAT} $FFF08080 {$ELSE} $FF8080F0 {$ENDIF});
  clLightCyan32           = TColor32({$IFNDEF RGBA_FORMAT} $FFE0FFFF {$ELSE} $FFFFFFE0 {$ENDIF});
  clLightGoldenRodYellow32= TColor32({$IFNDEF RGBA_FORMAT} $FFFAFAD2 {$ELSE} $FFD2FAFA {$ENDIF});
  clLightGreen32          = TColor32({$IFNDEF RGBA_FORMAT} $FF90EE90 {$ELSE} $FF90EE90 {$ENDIF});
  clLightGrey32           = TColor32({$IFNDEF RGBA_FORMAT} $FFD3D3D3 {$ELSE} $FFD3D3D3 {$ENDIF});
  clLightPink32           = TColor32({$IFNDEF RGBA_FORMAT} $FFFFB6C1 {$ELSE} $FFC1B6FF {$ENDIF});
  clLightSalmon32         = TColor32({$IFNDEF RGBA_FORMAT} $FFFFA07A {$ELSE} $FF7AA0FF {$ENDIF});
  clLightSeagreen32       = TColor32({$IFNDEF RGBA_FORMAT} $FF20B2AA {$ELSE} $FFAAB220 {$ENDIF});
  clLightSkyblue32        = TColor32({$IFNDEF RGBA_FORMAT} $FF87CEFA {$ELSE} $FFFACE87 {$ENDIF});
  clLightSlategray32      = TColor32({$IFNDEF RGBA_FORMAT} $FF778899 {$ELSE} $FF998877 {$ENDIF});
  clLightSlategrey32      = TColor32({$IFNDEF RGBA_FORMAT} $FF778899 {$ELSE} $FF998877 {$ENDIF});
  clLightSteelblue32      = TColor32({$IFNDEF RGBA_FORMAT} $FFB0C4DE {$ELSE} $FFDEC4B0 {$ENDIF});
  clLightYellow32         = TColor32({$IFNDEF RGBA_FORMAT} $FFFFFFE0 {$ELSE} $FFE0FFFF {$ENDIF});
  clLtGray32              = TColor32({$IFNDEF RGBA_FORMAT} $FFC0C0C0 {$ELSE} $FFC0C0C0 {$ENDIF});
  clMedGray32             = TColor32({$IFNDEF RGBA_FORMAT} $FFA0A0A4 {$ELSE} $FFA4A0A0 {$ENDIF});
  clDkGray32              = TColor32({$IFNDEF RGBA_FORMAT} $FF808080 {$ELSE} $FF808080 {$ENDIF});
  clMoneyGreen32          = TColor32({$IFNDEF RGBA_FORMAT} $FFC0DCC0 {$ELSE} $FFC0DCC0 {$ENDIF});
  clLegacySkyBlue32       = TColor32({$IFNDEF RGBA_FORMAT} $FFA6CAF0 {$ELSE} $FFF0CAA6 {$ENDIF});
  clCream32               = TColor32({$IFNDEF RGBA_FORMAT} $FFFFFBF0 {$ELSE} $FFF0FBFF {$ENDIF});
  clLimeGreen32           = TColor32({$IFNDEF RGBA_FORMAT} $FF32CD32 {$ELSE} $FF32CD32 {$ENDIF});
  clLinen32               = TColor32({$IFNDEF RGBA_FORMAT} $FFFAF0E6 {$ELSE} $FFE6F0FA {$ENDIF});
  clMediumAquamarine32    = TColor32({$IFNDEF RGBA_FORMAT} $FF66CDAA {$ELSE} $FFAACD66 {$ENDIF});
  clMediumBlue32          = TColor32({$IFNDEF RGBA_FORMAT} $FF0000CD {$ELSE} $FFCD0000 {$ENDIF});
  clMediumOrchid32        = TColor32({$IFNDEF RGBA_FORMAT} $FFBA55D3 {$ELSE} $FFD355BA {$ENDIF});
  clMediumPurple32        = TColor32({$IFNDEF RGBA_FORMAT} $FF9370DB {$ELSE} $FFDB7093 {$ENDIF});
  clMediumSeaGreen32      = TColor32({$IFNDEF RGBA_FORMAT} $FF3CB371 {$ELSE} $FF71B33C {$ENDIF});
  clMediumSlateBlue32     = TColor32({$IFNDEF RGBA_FORMAT} $FF7B68EE {$ELSE} $FFEE687B {$ENDIF});
  clMediumSpringGreen32   = TColor32({$IFNDEF RGBA_FORMAT} $FF00FA9A {$ELSE} $FF9AFA00 {$ENDIF});
  clMediumTurquoise32     = TColor32({$IFNDEF RGBA_FORMAT} $FF48D1CC {$ELSE} $FFCCD148 {$ENDIF});
  clMediumVioletRed32     = TColor32({$IFNDEF RGBA_FORMAT} $FFC71585 {$ELSE} $FF8515C7 {$ENDIF});
  clMidnightBlue32        = TColor32({$IFNDEF RGBA_FORMAT} $FF191970 {$ELSE} $FF701919 {$ENDIF});
  clMintCream32           = TColor32({$IFNDEF RGBA_FORMAT} $FFF5FFFA {$ELSE} $FFFAFFF5 {$ENDIF});
  clMistyRose32           = TColor32({$IFNDEF RGBA_FORMAT} $FFFFE4E1 {$ELSE} $FFE1E4FF {$ENDIF});
  clMoccasin32            = TColor32({$IFNDEF RGBA_FORMAT} $FFFFE4B5 {$ELSE} $FFB5E4FF {$ENDIF});
  clNavajoWhite32         = TColor32({$IFNDEF RGBA_FORMAT} $FFFFDEAD {$ELSE} $FFADDEFF {$ENDIF});
  clOldLace32             = TColor32({$IFNDEF RGBA_FORMAT} $FFFDF5E6 {$ELSE} $FFE6F5FD {$ENDIF});
  clOliveDrab32           = TColor32({$IFNDEF RGBA_FORMAT} $FF6B8E23 {$ELSE} $FF238E6B {$ENDIF});
  clOrange32              = TColor32({$IFNDEF RGBA_FORMAT} $FFFFA500 {$ELSE} $FF00A5FF {$ENDIF});
  clOrangeRed32           = TColor32({$IFNDEF RGBA_FORMAT} $FFFF4500 {$ELSE} $FF0045FF {$ENDIF});
  clOrchid32              = TColor32({$IFNDEF RGBA_FORMAT} $FFDA70D6 {$ELSE} $FFD670DA {$ENDIF});
  clPaleGoldenRod32       = TColor32({$IFNDEF RGBA_FORMAT} $FFEEE8AA {$ELSE} $FFAAE8EE {$ENDIF});
  clPaleGreen32           = TColor32({$IFNDEF RGBA_FORMAT} $FF98FB98 {$ELSE} $FF98FB98 {$ENDIF});
  clPaleTurquoise32       = TColor32({$IFNDEF RGBA_FORMAT} $FFAFEEEE {$ELSE} $FFEEEEAF {$ENDIF});
  clPaleVioletred32       = TColor32({$IFNDEF RGBA_FORMAT} $FFDB7093 {$ELSE} $FF9370DB {$ENDIF});
  clPapayaWhip32          = TColor32({$IFNDEF RGBA_FORMAT} $FFFFEFD5 {$ELSE} $FFD5EFFF {$ENDIF});
  clPeachPuff32           = TColor32({$IFNDEF RGBA_FORMAT} $FFFFDAB9 {$ELSE} $FFB9DAFF {$ENDIF});
  clPeru32                = TColor32({$IFNDEF RGBA_FORMAT} $FFCD853F {$ELSE} $FF3F85CD {$ENDIF});
  clPlum32                = TColor32({$IFNDEF RGBA_FORMAT} $FFDDA0DD {$ELSE} $FFDDA0DD {$ENDIF});
  clPowderBlue32          = TColor32({$IFNDEF RGBA_FORMAT} $FFB0E0E6 {$ELSE} $FFE6E0B0 {$ENDIF});
  clRosyBrown32           = TColor32({$IFNDEF RGBA_FORMAT} $FFBC8F8F {$ELSE} $FF8F8FBC {$ENDIF});
  clRoyalBlue32           = TColor32({$IFNDEF RGBA_FORMAT} $FF4169E1 {$ELSE} $FFE16941 {$ENDIF});
  clSaddleBrown32         = TColor32({$IFNDEF RGBA_FORMAT} $FF8B4513 {$ELSE} $FF13458B {$ENDIF});
  clSalmon32              = TColor32({$IFNDEF RGBA_FORMAT} $FFFA8072 {$ELSE} $FF7280FA {$ENDIF});
  clSandyBrown32          = TColor32({$IFNDEF RGBA_FORMAT} $FFF4A460 {$ELSE} $FF60A4F4 {$ENDIF});
  clSeaGreen32            = TColor32({$IFNDEF RGBA_FORMAT} $FF2E8B57 {$ELSE} $FF578B2E {$ENDIF});
  clSeaShell32            = TColor32({$IFNDEF RGBA_FORMAT} $FFFFF5EE {$ELSE} $FFEEF5FF {$ENDIF});
  clSienna32              = TColor32({$IFNDEF RGBA_FORMAT} $FFA0522D {$ELSE} $FF2D52A0 {$ENDIF});
  clSilver32              = TColor32({$IFNDEF RGBA_FORMAT} $FFC0C0C0 {$ELSE} $FFC0C0C0 {$ENDIF});
  clSkyblue32             = TColor32({$IFNDEF RGBA_FORMAT} $FF87CEEB {$ELSE} $FFEBCE87 {$ENDIF});
  clSlateBlue32           = TColor32({$IFNDEF RGBA_FORMAT} $FF6A5ACD {$ELSE} $FFCD5A6A {$ENDIF});
  clSlateGray32           = TColor32({$IFNDEF RGBA_FORMAT} $FF708090 {$ELSE} $FF908070 {$ENDIF});
  clSlateGrey32           = TColor32({$IFNDEF RGBA_FORMAT} $FF708090 {$ELSE} $FF908070 {$ENDIF});
  clSnow32                = TColor32({$IFNDEF RGBA_FORMAT} $FFFFFAFA {$ELSE} $FFFAFAFF {$ENDIF});
  clSpringgreen32         = TColor32({$IFNDEF RGBA_FORMAT} $FF00FF7F {$ELSE} $FF7FFF00 {$ENDIF});
  clSteelblue32           = TColor32({$IFNDEF RGBA_FORMAT} $FF4682B4 {$ELSE} $FFB48246 {$ENDIF});
  clTan32                 = TColor32({$IFNDEF RGBA_FORMAT} $FFD2B48C {$ELSE} $FF8CB4D2 {$ENDIF});
  clThistle32             = TColor32({$IFNDEF RGBA_FORMAT} $FFD8BFD8 {$ELSE} $FFD8BFD8 {$ENDIF});
  clTomato32              = TColor32({$IFNDEF RGBA_FORMAT} $FFFF6347 {$ELSE} $FF4763FF {$ENDIF});
  clTurquoise32           = TColor32({$IFNDEF RGBA_FORMAT} $FF40E0D0 {$ELSE} $FFD0E040 {$ENDIF});
  clViolet32              = TColor32({$IFNDEF RGBA_FORMAT} $FFEE82EE {$ELSE} $FFEE82EE {$ENDIF});
  clWheat32               = TColor32({$IFNDEF RGBA_FORMAT} $FFF5DEB3 {$ELSE} $FFB3DEF5 {$ENDIF});
  clWhitesmoke32          = TColor32({$IFNDEF RGBA_FORMAT} $FFF5F5F5 {$ELSE} $FFF5F5F5 {$ENDIF});
  clYellowgreen32         = TColor32({$IFNDEF RGBA_FORMAT} $FF9ACD32 {$ELSE} $FF32CD9A {$ENDIF});

  // Some semi-transparent color constants
  clTrWhite32             = TColor32({$IFNDEF RGBA_FORMAT} $7FFFFFFF {$ELSE} $7FFFFFFF {$ENDIF});
  clTrGray32              = TColor32({$IFNDEF RGBA_FORMAT} $7F7F7F7F {$ELSE} $7F7F7F7F {$ENDIF});
  clTrBlack32             = TColor32({$IFNDEF RGBA_FORMAT} $7F000000 {$ELSE} $7F000000 {$ENDIF});
  clTrRed32               = TColor32({$IFNDEF RGBA_FORMAT} $7FFF0000 {$ELSE} $7F0000FF {$ENDIF});
  clTrGreen32             = TColor32({$IFNDEF RGBA_FORMAT} $7F00FF00 {$ELSE} $7F00FF00 {$ENDIF});
  clTrBlue32              = TColor32({$IFNDEF RGBA_FORMAT} $7F0000FF {$ELSE} $7FFF0000 {$ENDIF});

// Color construction and conversion functions
function Color32(WinColor: TColor): TColor32; overload;
function Color32(R, G, B: Byte; A: Byte = $FF): TColor32; overload;
function Color32(Index: Byte; var Palette: TPalette32): TColor32; overload;
{$IFNDEF FPC}
// Note: No overload for TAlphaColor since it would conflict with TColor
function Color32(const AlphaColor: TAlphaColorRec): TColor32; overload;
{$ENDIF}
function Gray32(Intensity: Byte; Alpha: Byte = $FF): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
function WinColor(Color32: TColor32): TColor;
function ArrayOfColor32(const Colors: array of TColor32): TArrayOfColor32;

// Unconditionally swap R & B channel, leave rest alone
function SwapRedBlue(Color32: TColor32): TColor32;
procedure SwapRedBlueMem(var Color32: TColor32);

// Conditional swaps. Depends on RGBA_FORMAT define.
function Color32ToBGRA(Color32: TColor32): DWORD; {$IFDEF USEINLINING} inline; {$ENDIF}
procedure Color32ToBGRAMem(var Color32: TColor32); {$IFDEF USEINLINING} inline; {$ENDIF}
function Color32ToRGBA(Color32: TColor32): DWORD; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
procedure Color32ToRGBAMem(var Color32: TColor32); {$IFDEF USEINLINING} inline; {$ENDIF}

function BGRAToColor32(BGRA: DWORD): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
procedure BGRAToColor32Mem(var BGRA: DWORD); {$IFDEF USEINLINING} inline; {$ENDIF}
function RGBAToColor32(RGBA: DWORD): TColor32; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
procedure RGBAToColor32mem(var RGBA: DWORD); {$IFDEF USEINLINING} inline; {$ENDIF}

// Color component access
procedure Color32ToRGB(Color32: TColor32; var R, G, B: Byte);
procedure Color32ToRGBA(Color32: TColor32; var R, G, B, A: Byte); overload;
function Color32Components(R, G, B, A: Boolean): TColor32Components;
function RedComponent(Color32: TColor32): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
function GreenComponent(Color32: TColor32): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
function BlueComponent(Color32: TColor32): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
function AlphaComponent(Color32: TColor32): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
function Intensity(Color32: TColor32): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
function InvertColor(Color32: TColor32): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
function SetAlpha(Color32: TColor32; NewAlpha: Integer): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
procedure ModifyAlpha(var Color32: TColor32; NewAlpha: Byte); {$IFDEF USEINLINING} inline; {$ENDIF}
procedure ScaleAlpha(var Color32: TColor32; Scale: Single); {$IFDEF USEINLINING} inline; {$ENDIF}

// Color space conversion
function HSLtoRGB(H, S, L: Single; A: Integer = 255): TColor32; overload;
function HSLtoRGB(H, S, L: Integer; A: Integer = 255): TColor32; overload;
procedure RGBtoHSL(RGB: TColor32; out H, S, L : Single); overload;
procedure RGBtoHSL(RGB: TColor32; out H, S, L: Byte); overload;
function HSVtoRGB(H, S, V: Single; A: Integer = 255): TColor32;
procedure RGBToHSV(Color: TColor32; out H, S, V: Single);

{$if (not defined(PLATFORM_INDEPENDENT)) and (not defined(RGBA_FORMAT))}
// Palette conversion functions
function WinPalette(const P: TPalette32): HPALETTE;
{$ifend}

{ A fixed-point type }

type
  // This type has data bits arrangement compatible with Windows.TFixed
  PFixed = ^TFixed;
  TFixed = type Integer;
  {$NODEFINE TFixed}

  {$NODEFINE PFixedRec}
  PFixedRec = ^TFixedRec;
  {$NODEFINE TFixedRec}
  TFixedRec = packed record
    case Integer of
      0: (Fixed: TFixed);
      1: (Frac: Word; Int: SmallInt);
  end;

  PFixedArray = ^TFixedArray;
  TFixedArray = array [0..0] of TFixed;
  PArrayOfFixed = ^TArrayOfFixed;
  TArrayOfFixed = array of TFixed;
  PArrayOfArrayOfFixed = ^TArrayOfArrayOfFixed;
  TArrayOfArrayOfFixed = array of TArrayOfFixed;

  // TFloat determines the precision level for certain floating-point operations
  PFloat = ^TFloat;
  TFloat = Single;

{ Various arrays }
type
  PByteArray = ^TByteArray;
  TByteArray = array [0..0] of Byte;
  PArrayOfByte = ^TArrayOfByte;
  TArrayOfByte = array of Byte;

  PWordArray = ^TWordArray;
  TWordArray = array [0..0] of Word;
  PArrayOfWord = ^TArrayOfWord;
  TArrayOfWord = array of Word;

  PIntegerArray = ^TIntegerArray;
  TIntegerArray = array [0..0] of Integer;
  PArrayOfInteger = ^TArrayOfInteger;
  TArrayOfInteger = array of Integer;
  PArrayOfArrayOfInteger = ^TArrayOfArrayOfInteger;
  TArrayOfArrayOfInteger = array of TArrayOfInteger;

  PCardinalArray = ^TCardinalArray;
  TCardinalArray = array [0..0] of Cardinal;
  PArrayOfCardinal = ^TArrayOfCardinal;
  TArrayOfCardinal = array of Cardinal;
  PArrayOfArrayOfCardinal = ^TArrayOfArrayOfCardinal;
  TArrayOfArrayOfCardinal = array of TArrayOfCardinal;

  PSingleArray = ^TSingleArray;
  TSingleArray = array [0..0] of Single;
  PArrayOfSingle = ^TArrayOfSingle;
  TArrayOfSingle = array of Single;

  PFloatArray = ^TFloatArray;
  TFloatArray = array [0..0] of TFloat;
  PArrayOfFloat = ^TArrayOfFloat;
  TArrayOfFloat = array of TFloat;

const
  // Fixed point math constants
  FixedOne = $10000;
  FixedHalf = $7FFF;
  FixedPI: Double = Round(PI * FixedOne);
  FixedToFloat: Double = 1 / FixedOne;

  COne255th: Double = 1 / $FF;


function Fixed(S: Single): TFixed; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function Fixed(I: Integer): TFixed; overload; {$IFDEF USEINLINING} inline; {$ENDIF}


//------------------------------------------------------------------------------
//
//      Point types
//
//------------------------------------------------------------------------------

//------------------------------------------------------------------------------
// TPoint
//------------------------------------------------------------------------------
// Identical to the Windows POINT structure.
//------------------------------------------------------------------------------
type
  TPoint = {$ifndef FPC}System.{$endif}Types.TPoint;
  PPoint = {$ifndef FPC}System.{$endif}Types.PPoint;

  PPointArray = ^TPointArray;
  TPointArray = array [0..0] of TPoint;
  PArrayOfPoint = ^TArrayOfPoint;
  TArrayOfPoint = array of TPoint;
  PArrayOfArrayOfPoint = ^TArrayOfArrayOfPoint;
  TArrayOfArrayOfPoint = array of TArrayOfPoint;


//------------------------------------------------------------------------------
// TFloatPoint
//------------------------------------------------------------------------------
// Floating point, single precision, point
// Identical to the RTL Types.TPointF type.
//------------------------------------------------------------------------------
type
{$if defined(HAS_TPOINTF)}

  TFloatPoint = {$ifndef FPC}System.{$endif}Types.TPointF;

{$else}

  TFloatPoint = record
    X, Y: TFloat;
  public
  {$IFDEF RECORD_CONSTRUCTORS}
    constructor Create(P: TPoint); overload;
    constructor Create(X, Y: Integer); overload;
    constructor Create(X, Y: Single); overload;
  {$ENDIF}

    // operator overloads
    class operator Equal(const Lhs, Rhs: TFloatPoint): Boolean;
    class operator NotEqual(const Lhs, Rhs: TFloatPoint): Boolean;
    class operator Add(const Lhs, Rhs: TFloatPoint): TFloatPoint;
    class operator Subtract(const Lhs, Rhs: TFloatPoint): TFloatPoint;
    class operator Explicit(A: TPointF): TFloatPoint;
    class operator Implicit(A: TPointF): TFloatPoint;

    class function Zero: TFloatPoint; inline; static;
  end;

{$ifend}

  PFloatPoint = ^TFloatPoint;


  PFloatPointArray = ^TFloatPointArray;
  TFloatPointArray = array [0..0] of TFloatPoint;
  PArrayOfFloatPoint = ^TArrayOfFloatPoint;
  TArrayOfFloatPoint = array of TFloatPoint;
  PArrayOfArrayOfFloatPoint = ^TArrayOfArrayOfFloatPoint;
  TArrayOfArrayOfFloatPoint = array of TArrayOfFloatPoint;


//------------------------------------------------------------------------------
// TFixedPoint
//------------------------------------------------------------------------------
// Fixed precision point.
//------------------------------------------------------------------------------
type
  TFixedPoint = record
    X, Y: TFixed;
  public
{$IFDEF RECORD_CONSTRUCTORS}
    constructor Create(P: TFloatPoint); overload;
    constructor Create(X, Y: TFixed); overload;
    constructor Create(X, Y: Integer); overload;
    constructor Create(X, Y: TFloat); overload;
{$ENDIF}

    // operator overloads
    class operator Equal(const Lhs, Rhs: TFixedPoint): Boolean;
    class operator NotEqual(const Lhs, Rhs: TFixedPoint): Boolean;
    class operator Add(const Lhs, Rhs: TFixedPoint): TFixedPoint;
    class operator Subtract(const Lhs, Rhs: TFixedPoint): TFixedPoint;

    class function Zero: TFixedPoint; inline; static;
  end;

  PFixedPoint = ^TFixedPoint;

  {$NODEFINE TFixedPoint}

  PFixedPointArray = ^TFixedPointArray;
  TFixedPointArray = array [0..0] of TFixedPoint;
  PArrayOfFixedPoint = ^TArrayOfFixedPoint;
  TArrayOfFixedPoint = array of TFixedPoint;
  PArrayOfArrayOfFixedPoint = ^TArrayOfArrayOfFixedPoint;
  TArrayOfArrayOfFixedPoint = array of TArrayOfFixedPoint;


//------------------------------------------------------------------------------
// construction and conversion of point types
//------------------------------------------------------------------------------
function Point(X, Y: Integer): TPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function Point(const FP: TFloatPoint): TPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function Point(const FXP: TFixedPoint): TPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FloatPoint(X, Y: Single): TFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FloatPoint(const P: TPoint): TFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FloatPoint(const FXP: TFixedPoint): TFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FixedPoint(X, Y: Integer): TFixedPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FixedPoint(X, Y: Single): TFixedPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FixedPoint(const P: TPoint): TFixedPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FixedPoint(const FP: TFloatPoint): TFixedPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}


//------------------------------------------------------------------------------
//
//      Rectangle types
//
//------------------------------------------------------------------------------

//------------------------------------------------------------------------------
// TRect
//------------------------------------------------------------------------------
// Identical to the Windows RECT structure.
//------------------------------------------------------------------------------
type
  TRect = {$ifndef FPC}System.{$endif}Types.TRect;
  PRect = {$ifndef FPC}System.{$endif}Types.PRect;


{$IFDEF SupportsBoost}
  (*$HPPEMIT '#include <boost/strong_typedef.hpp>'*)
{$ENDIF}
  (*$HPPEMIT 'namespace Gr32 {'*)
{$IFDEF SupportsBoost}
  (*$HPPEMIT 'BOOST_STRONG_TYPEDEF(int, TFixed)'*)
{$ELSE}
  (*$HPPEMIT 'typedef int TFixed;'*)
{$ENDIF}
  (*$HPPEMIT 'struct TFixedPoint { float X, Y; }; typedef struct TFixedPoint TFixedPoint;'*)
{$if not defined(HAS_TRECTF)}
  (*$HPPEMIT 'struct TFloatRect { float Left, Top, Right, Bottom; }; typedef struct TFloatRect TFloatRect;'*)
{$ifend}
  (*$HPPEMIT 'struct TFixedRect { TFixed Left, Top, Right, Bottom; }; typedef struct TFixedRect TFixedRect;'*)
  (*$HPPEMIT '} // namespace Gr32 '*)

//------------------------------------------------------------------------------
// TFloatRect
//------------------------------------------------------------------------------
// Single precision, floating point rectangle.
// Identical to the RTL Types.TRectF type.
//------------------------------------------------------------------------------
type
{$if defined(HAS_TRECTF)}

  TFloatRect = {$ifndef FPC}System.{$endif}Types.TRectF;

{$else}

  {$NODEFINE TFloatRect}

  TFloatRect = packed record
  private
    function GetWidth: TFloat; {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure SetWidth(const Value: TFloat); {$IFDEF USEINLINING} inline; {$ENDIF}
    function GetHeight: TFloat; {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure SetHeight(const Value: TFloat); {$IFDEF USEINLINING} inline; {$ENDIF}
  public
    // operator overloads
    class operator Equal(const Lhs, Rhs: TFloatRect): Boolean; {$IFDEF USEINLINING} inline; {$ENDIF}
    class operator NotEqual(const Lhs, Rhs: TFloatRect): Boolean; {$IFDEF USEINLINING} inline; {$ENDIF}
    class operator Implicit(const Source: TRect): TFloatRect; {$IFDEF USEINLINING} inline; {$ENDIF}
    class operator Explicit(const Source: TFloatRect): TRect; {$IFDEF USEINLINING} inline; {$ENDIF}

    procedure Offset(const DX, DY: Single); overload; {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure Offset(const Point: TPointF); overload; {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure Offset(const Point: TPoint); overload; {$IFDEF USEINLINING} inline; {$ENDIF}

    function Contains(const Pt: TPointF): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
    function Contains(const Pt: TPoint): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
    function Contains(const R: TRectF): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}

    procedure Inflate(const DX, DY: Single); {$IFDEF USEINLINING} inline; {$ENDIF}

    property Width: TFloat read GetWidth write SetWidth;
    property Height: TFloat read GetHeight write SetHeight;

    case Integer of
      0: (Left, Top, Right, Bottom: TFloat);
      1: (TopLeft, BottomRight: TFloatPoint);
  end;

{$ifend}

  PFloatRect = ^TFloatRect;


//------------------------------------------------------------------------------
// TFixedRect
//------------------------------------------------------------------------------
// Fixed point rectangle
//------------------------------------------------------------------------------
  {$NODEFINE PFixedRect}
  PFixedRect = ^TFixedRect;
  {$NODEFINE TFixedRect}
  TFixedRect = packed record
  private
    function GetWidth: TFixed; {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure SetWidth(const Value: TFixed); {$IFDEF USEINLINING} inline; {$ENDIF}
    function GetHeight: TFixed; {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure SetHeight(const Value: TFixed); {$IFDEF USEINLINING} inline; {$ENDIF}
  public
    class operator Equal(const Lhs, Rhs: TFixedRect): Boolean; {$IFDEF USEINLINING} inline; {$ENDIF}
    class operator NotEqual(const Lhs, Rhs: TFixedRect): Boolean; {$IFDEF USEINLINING} inline; {$ENDIF}
    class operator Implicit(const Source: TRect): TFixedRect; {$IFDEF USEINLINING} inline; {$ENDIF}
    class operator Implicit(const Source: TFloatRect): TFixedRect; {$IFDEF USEINLINING} inline; {$ENDIF}
    class operator Explicit(const Source: TFixedRect): TFloatRect; {$IFDEF USEINLINING} inline; {$ENDIF}
    class operator Explicit(const Source: TFixedRect): TRect; {$IFDEF USEINLINING} inline; {$ENDIF}

    property Width: TFixed read GetWidth write SetWidth;
    property Height: TFixed read GetHeight write SetHeight;

    case Integer of
      0: (Left, Top, Right, Bottom: TFixed);
      1: (TopLeft, BottomRight: TFixedPoint);
  end;

//------------------------------------------------------------------------------
// Rectangle construction/conversion functions
//------------------------------------------------------------------------------
type
  TRectRounding = (rrClosest, rrOutside, rrInside);

function MakeRect(const L, T, R, B: Integer): TRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function MakeRect(const FR: TFloatRect; Rounding: TRectRounding = rrClosest): TRect; overload;
function MakeRect(const FXR: TFixedRect; Rounding: TRectRounding = rrClosest): TRect; overload;
function FixedRect(const L, T, R, B: TFixed): TFixedRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FixedRect(const TopLeft, BottomRight: TFixedPoint): TFixedRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FixedRect(const ARect: TRect): TFixedRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FixedRect(const FR: TFloatRect): TFixedRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FloatRect(const L, T, R, B: TFloat): TFloatRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FloatRect(const TopLeft, BottomRight: TFloatPoint): TFloatRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FloatRect(const ARect: TRect): TFloatRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function FloatRect(const FXR: TFixedRect): TFloatRect; overload; {$IFDEF USEINLINING} inline; {$ENDIF}

//------------------------------------------------------------------------------
// Some basic operations over rectangles
//------------------------------------------------------------------------------
function IntersectRect(out Dst: TRect; const R1, R2: TRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF} // TODO : Semantics differ from Delphi IntersectRect
function IntersectRect(out Dst: TFloatRect; const FR1, FR2: TFloatRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function UnionRect(out Rect: TRect; const R1, R2: TRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function UnionRect(out Rect: TFloatRect; const R1, R2: TFloatRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function EqualRect(const R1, R2: TRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function EqualRect(const R1, R2: TFloatRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
procedure InflateRect(var R: TRect; Dx, Dy: Integer); overload; {$IFDEF USEINLINING} inline; {$ENDIF}
procedure InflateRect(var FR: TFloatRect; Dx, Dy: TFloat); overload; {$IFDEF USEINLINING} inline; {$ENDIF}
procedure OffsetRect(var R: TRect; Dx, Dy: Integer); overload; {$IFDEF USEINLINING} inline; {$ENDIF}
procedure OffsetRect(var FR: TFloatRect; Dx, Dy: TFloat); overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function IsRectEmpty(const R: TRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function IsRectEmpty(const FR: TFloatRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function PtInRect(const R: TRect; const P: TPoint): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function PtInRect(const R: TFloatRect; const P: TPoint): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function PtInRect(const R: TRect; const P: TFloatPoint): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function PtInRect(const R: TFloatRect; const P: TFloatPoint): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function EqualRectSize(const R1, R2: TRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
function EqualRectSize(const R1, R2: TFloatRect): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}


type
{ TBitmap32 draw mode }
  TDrawMode = (dmOpaque, dmBlend, dmCustom, dmTransparent);
  TCombineMode = (cmBlend, cmMerge);
  TWrapMode = (wmClamp, wmRepeat, wmMirror{$ifdef GR32_WRAPMODE_REFLECT}, wmReflect{$endif});
  TWrapProc = function(Value, Max: Integer): Integer;
  TWrapProcEx = function(Value, Min, Max: Integer): Integer;

type
  { TPlainInterfacedPersistent }
  { TPlainInterfacedPersistent provides simple interface support with
    optional reference-counting operation. }
  TPlainInterfacedPersistent = class(TPersistent, IInterface)
  strict private
    FRefCounted: Boolean;
    FRefCount: Integer;
  protected
    { IInterface }
{$IFDEF FPC_HAS_CONSTREF}
    function QueryInterface(constref iid: TGuid; out obj): HResult; {$ifdef MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
    function _AddRef: LongInt; {$ifdef MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
    function _Release: LongInt; {$ifdef MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
{$ELSE}
    function QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
    function _AddRef: LongInt; stdcall;
    function _Release: LongInt; stdcall;
{$ENDIF}
    property RefCounted: Boolean read FRefCounted write FRefCounted;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;

    property RefCount: Integer read FRefCount;
  end;

  { TNotifiablePersistent }
  { TNotifiablePersistent provides a change notification mechanism }
  TNotifiablePersistent = class(TPlainInterfacedPersistent)
  strict private
    FUpdateCount: Integer;
    FLockUpdateCount: Integer;
    FModified: boolean;
    FOnChange: TNotifyEvent;
  strict protected
    procedure DoChanged; virtual;
  protected
    property UpdateCount: Integer read FUpdateCount;
    property LockUpdateCount: Integer read FLockUpdateCount;
    property Modified: boolean read FModified;
  public
    procedure BeforeDestruction; override;
    procedure BeginUpdate; virtual;
    procedure EndUpdate; virtual;
    procedure Changed; virtual;

    procedure BeginLockUpdate; {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure EndLockUpdate; {$IFDEF USEINLINING} inline; {$ENDIF}

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { TThreadPersistent }
  { TThreadPersistent is an ancestor for TBitmap32 object. In addition to
    TPersistent methods, it provides thread-safe locking and change notification }
  TThreadPersistent = class(TNotifiablePersistent)
  strict private
    FLockCount: Integer;
  strict protected
    // FLock *must* be a Win32 RTL_CRITICAL_SECTION as it is referenced directly
    // via a pointer by TFont.OwnerCriticalSection in the backend.
    // Absolutely wonderfull design Embarcadero!
    {$IFDEF FPC}
    FLock: TCriticalSection;
    {$ELSE}
    FLock: TRTLCriticalSection;
    {$ENDIF}
    property LockCount: Integer read FLockCount;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Lock;
    procedure Unlock;
  end;

  { TCustomMap }
  { An ancestor for bitmaps and similar 2D distributions wich have width and
    height properties }
  TCustomMap = class(TThreadPersistent)
  protected
    FHeight: Integer;
    FWidth: Integer;
  strict protected
    FOnResize: TNotifyEvent;
    procedure SetHeight(NewHeight: Integer); virtual;
    procedure SetWidth(NewWidth: Integer); virtual;
    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); virtual;
  public
    constructor Create(Width, Height: Integer); reintroduce; overload;
    destructor Destroy; override;

    procedure Delete; virtual;
    function  Empty: Boolean; virtual;
    procedure Resized; virtual;
    function SetSizeFrom(Source: TPersistent): Boolean;
    function SetSize(NewWidth, NewHeight: Integer): Boolean; virtual;

    property Height: Integer read FHeight write SetHeight;
    property Width: Integer read FWidth write SetWidth;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
  end;

  { TBitmap32 }
  { This is the core of Graphics32 unit. The TBitmap32 class is responsible
    for storage of a bitmap, as well as for drawing in it.
    The OnCombine event is fired only when DrawMode is set to dmCustom and two
    bitmaps are blended together. Unlike most normal events, it does not contain
    "Sender" parameter and is not called through some virtual method. This
    (a little bit non-standard) approach allows for faster operation. }

const
  // common cases
  AREAINFO_RECT         = $80000000;
  AREAINFO_LINE         = $40000000; // 24 bits for line width in pixels...
  AREAINFO_ELLIPSE      = $20000000;
  AREAINFO_ABSOLUTE     = $10000000;

  AREAINFO_MASK         = $FF000000;

type
  TPixelCombineEvent = procedure(F: TColor32; var B: TColor32; M: Cardinal) of object;
  TAreaChangedEvent = procedure(Sender: TObject; const Area: TRect;
    const Info: Cardinal) of object;

  TCustomResampler = class;

  TCustomBackend = class;
  TCustomBackendClass = class of TCustomBackend;

{$ifndef FPC}
  TResourceType = PChar;
{$else FPC}
  TResourceType = LCLType.TResourceType;
{$endif FPC}

  { TCustomBitmap32 }

  TCustomBitmap32 = class(TCustomMap)
  strict private
    FBackend: TCustomBackend;
    FBits: PColor32Array;
    FClipRect: TRect;
    FFixedClipRect: TFixedRect;
    F256ClipRect: TRect;
    FClipping: Boolean;
    FDrawMode: TDrawMode;
    FCombineMode: TCombineMode;
    FWrapMode: TWrapMode;

    FMasterAlpha: Cardinal;
    FOuterColor: TColor32;
    FPenColor: TColor32;
    FStippleCounter: Single;
    FStipplePattern: TArrayOfColor32;
    FStippleStep: Single;
    FOnPixelCombine: TPixelCombineEvent;
    FOnAreaChanged: TAreaChangedEvent;
    FOldOnAreaChanged: TAreaChangedEvent;
    FMeasuringMode: Boolean;
    FResampler: TCustomResampler;

{$IFDEF BITS_GETTER}
    function GetBits: PColor32Array; {$IFDEF USEINLINING} inline; {$ENDIF}
{$ENDIF}

    function GetPixelPtr(X, Y: Integer): PColor32;
    function GetScanLine(Y: Integer): PColor32Array;

    procedure SetCombineMode(const Value: TCombineMode);
    procedure SetDrawMode(Value: TDrawMode);
    procedure SetWrapMode(Value: TWrapMode);
    procedure SetMasterAlpha(Value: Cardinal);
    procedure SetClipRect(const Value: TRect);
    procedure SetResampler(AResampler: TCustomResampler);
    function GetResamplerClassName: string;
    procedure SetResamplerClassName(const Value: string);
    function GetPenPos: TPoint;
    procedure SetPenPos(const Value: TPoint);
    function GetPenPosF: TFixedPoint;
    procedure SetPenPosF(const Value: TFixedPoint);
  public type
    TInfoHeaderVersion = (InfoHeaderVersion1, InfoHeaderVersion2, InfoHeaderVersion3, InfoHeaderVersion4, InfoHeaderVersion5);
  strict protected
    procedure BackendChangedHandler(Sender: TObject); virtual;
    procedure BackendChangingHandler(Sender: TObject); virtual;
  strict protected
    WrapProcHorz: TWrapProcEx;
    WrapProcVert: TWrapProcEx;
    BlendProc: Pointer;
    RasterX, RasterY: Integer;
    RasterXF, RasterYF: TFixed;
    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
    function  Equal(B: TCustomBitmap32): Boolean;
    procedure ReadData(Stream: TStream); virtual;
    procedure WriteData(Stream: TStream); virtual;

    procedure InitializeBackend(ABackendClass: TCustomBackendClass); virtual;
    procedure FinalizeBackend; virtual;
    procedure SetBackend(const ABackend: TCustomBackend); virtual;

{$IFDEF FPC_HAS_CONSTREF}
    function QueryInterface(constref iid: TGuid; out obj): HResult; {$ifdef MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
{$ELSE}
    function QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
{$ENDIF}

  protected
    procedure CopyPropertiesTo(Dst: TCustomBitmap32); virtual;

    procedure AssignTo(Dst: TPersistent); override;
    procedure DefineProperties(Filer: TFiler); override;

  protected
    function LoadFromBMPStream(Stream: TStream; Size: Int64): boolean;
    function LoadFromDIBStream(Stream: TStream; Size: Int64): boolean;
    procedure SaveToDIBStream(Stream: TStream; SaveTopDown: Boolean = False; IncludeColorTable: boolean = False); overload;
    procedure SaveToDIBStream(Stream: TStream; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion; IncludeColorTable: boolean = False); overload;
    procedure SaveToStream(Stream: TStream; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion; IncludeColorTable: boolean); overload;
    procedure SaveToFile(const FileName: string; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion; IncludeColorTable: boolean); overload;

  protected
    procedure SET_T256(X, Y: Integer; C: TColor32);
    procedure SET_TS256(X, Y: Integer; C: TColor32);
    function  GET_T256(X, Y: Integer): TColor32;
    function  GET_TS256(X, Y: Integer): TColor32;

    function  GetPixel(X, Y: Integer): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
    function  GetPixelS(X, Y: Integer): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
    function  GetPixelW(X, Y: Integer): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}

    function  GetPixelF(X, Y: Single): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
    function  GetPixelFS(X, Y: Single): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}
    function  GetPixelFW(X, Y: Single): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}

    function  GetPixelX(X, Y: TFixed): TColor32;
    function  GetPixelXS(X, Y: TFixed): TColor32;
    function  GetPixelXW(X, Y: TFixed): TColor32;

    function GetPixelFR(X, Y: Single): TColor32;
    function GetPixelXR(X, Y: TFixed): TColor32;

    function  GetPixelB(X, Y: Integer): TColor32; {$IFDEF USEINLINING} inline; {$ENDIF}

    procedure SetPixel(X, Y: Integer; Value: TColor32); {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure SetPixelS(X, Y: Integer; Value: TColor32);
    procedure SetPixelW(X, Y: Integer; Value: TColor32); {$IFDEF USEINLINING} inline; {$ENDIF}

    procedure SetPixelF(X, Y: Single; Value: TColor32);  {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure SetPixelFS(X, Y: Single; Value: TColor32);
    procedure SetPixelFW(X, Y: Single; Value: TColor32);

    procedure SetPixelX(X, Y: TFixed; Value: TColor32); {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure SetPixelXS(X, Y: TFixed; Value: TColor32);
    procedure SetPixelXW(X, Y: TFixed; Value: TColor32);
  public
    constructor Create(ABackendClass: TCustomBackendClass); reintroduce; overload; virtual;
    constructor Create; reintroduce; overload; virtual;
    constructor Create(Width, Height: Integer); reintroduce; overload; virtual;
    destructor Destroy; override;

    class function GetPlatformBackendClass: TCustomBackendClass; virtual;

    procedure Changed; overload; override;
    procedure Changed(const Area: TRect; const Info: Cardinal = AREAINFO_RECT); reintroduce; overload; virtual;

    procedure CopyMapTo(Dst: TCustomBitmap32); virtual;
    procedure Assign(Source: TPersistent); override;
    function  BoundsRect: TRect;
    function  Empty: Boolean; override;
    procedure Clear; overload;
    procedure Clear(FillColor: TColor32); overload;
    procedure Delete; override;

    procedure BeginMeasuring(const Callback: TAreaChangedEvent);
    procedure EndMeasuring;

    function ReleaseBackend: TCustomBackend;

    procedure PropertyChanged; virtual;

    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream; SaveTopDown: Boolean = False); overload; virtual;
    procedure SaveToStream(Stream: TStream; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion); overload; virtual;

    procedure LoadFromFile(const FileName: string); virtual;
    procedure SaveToFile(const FileName: string); overload; virtual;
    procedure SaveToFile(const FileName: string; SaveTopDown: Boolean); overload; virtual;
    procedure SaveToFile(const FileName: string; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion); overload; virtual;

    procedure LoadFromResourceID(Instance: THandle; ResID: Integer; ResType: TResourceType = RT_BITMAP);
    procedure LoadFromResourceName(Instance: THandle; const ResName: string; ResType: TResourceType = RT_BITMAP);

    procedure ResetAlpha; overload;
    procedure ResetAlpha(const AlphaValue: Byte); overload;

    procedure Draw(DstX, DstY: Integer; Src: TCustomBitmap32); overload;
    procedure Draw(DstX, DstY: Integer; const SrcRect: TRect; Src: TCustomBitmap32); overload;
    procedure Draw(const DstRect, SrcRect: TRect; Src: TCustomBitmap32); overload;

    procedure SetPixelT(X, Y: Integer; Value: TColor32); overload;
    procedure SetPixelT(var Ptr: PColor32; Value: TColor32); overload;
    procedure SetPixelTS(X, Y: Integer; Value: TColor32);

    procedure DrawTo(Dst: TCustomBitmap32); overload;
    procedure DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer); overload;
    procedure DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer; const SrcRect: TRect); overload;
    procedure DrawTo(Dst: TCustomBitmap32; const DstRect: TRect); overload;
    procedure DrawTo(Dst: TCustomBitmap32; const DstRect, SrcRect: TRect); overload;

    procedure SetStipple(const NewStipple: TArrayOfColor32); overload;
    procedure SetStipple(const NewStipple: array of TColor32); overload;
    procedure AdvanceStippleCounter(LengthPixels: Single);
    function  GetStippleColor: TColor32;

    procedure HorzLine(X1, Y, X2: Integer; Value: TColor32);
    procedure HorzLineS(X1, Y, X2: Integer; Value: TColor32);
    procedure HorzLineT(X1, Y, X2: Integer; Value: TColor32);
    procedure HorzLineTS(X1, Y, X2: Integer; Value: TColor32);
    procedure HorzLineTSP(X1, Y, X2: Integer);
    procedure HorzLineX(X1, Y, X2: TFixed; Value: TColor32);
    procedure HorzLineXS(X1, Y, X2: TFixed; Value: TColor32);

    procedure VertLine(X, Y1, Y2: Integer; Value: TColor32);
    procedure VertLineS(X, Y1, Y2: Integer; Value: TColor32);
    procedure VertLineT(X, Y1, Y2: Integer; Value: TColor32);
    procedure VertLineTS(X, Y1, Y2: Integer; Value: TColor32);
    procedure VertLineTSP(X, Y1, Y2: Integer);
    procedure VertLineX(X, Y1, Y2: TFixed; Value: TColor32);
    procedure VertLineXS(X, Y1, Y2: TFixed; Value: TColor32);

    procedure Line(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False);
    procedure LineS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False);
    procedure LineT(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False);
    procedure LineTS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False);
    procedure LineA(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False);
    procedure LineAS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False);
    procedure LineX(X1, Y1, X2, Y2: TFixed; Value: TColor32; L: Boolean = False); overload;
    procedure LineF(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean = False); overload;
    procedure LineXS(X1, Y1, X2, Y2: TFixed; Value: TColor32; L: Boolean = False); overload;
    procedure LineFS(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean = False); overload;
    procedure LineXP(X1, Y1, X2, Y2: TFixed; L: Boolean = False); overload;
    procedure LineFP(X1, Y1, X2, Y2: Single; L: Boolean = False); overload;
    procedure LineXSP(X1, Y1, X2, Y2: TFixed; L: Boolean = False); overload;
    procedure LineFSP(X1, Y1, X2, Y2: Single; L: Boolean = False); overload;

    property  PenColor: TColor32 read FPenColor write FPenColor;
    procedure MoveTo(X, Y: Integer);
    procedure LineToS(X, Y: Integer);
    procedure LineToTS(X, Y: Integer);
    procedure LineToAS(X, Y: Integer);
    procedure MoveToX(X, Y: TFixed);
    procedure MoveToF(X, Y: Single);
    procedure LineToXS(X, Y: TFixed);
    procedure LineToFS(X, Y: Single);
    procedure LineToXSP(X, Y: TFixed);
    procedure LineToFSP(X, Y: Single);
    property PenPos: TPoint read GetPenPos write SetPenPos;
    property PenPosF: TFixedPoint read GetPenPosF write SetPenPosF;

    procedure FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32);
    procedure FillRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); overload;
    procedure FillRectT(X1, Y1, X2, Y2: Integer; Value: TColor32);
    procedure FillRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); overload;
    procedure FillRectS(const ARect: TRect; Value: TColor32); overload;
    procedure FillRectTS(const ARect: TRect; Value: TColor32); overload;

    procedure FrameRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); overload;
    procedure FrameRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); overload;
    procedure FrameRectTSP(X1, Y1, X2, Y2: Integer);
    procedure FrameRectS(const ARect: TRect; Value: TColor32); overload;
    procedure FrameRectTS(const ARect: TRect; Value: TColor32); overload;

    procedure RaiseRectTS(X1, Y1, X2, Y2: Integer; Contrast: Integer); overload;
    procedure RaiseRectTS(const ARect: TRect; Contrast: Integer); overload;

    procedure Roll(Dx, Dy: Integer; FillBack: Boolean; FillColor: TColor32);
    procedure FlipHorz(Dst: TCustomBitmap32 = nil);
    procedure FlipVert(Dst: TCustomBitmap32 = nil);
    procedure Rotate90(Dst: TCustomBitmap32 = nil);
    procedure Rotate180(Dst: TCustomBitmap32 = nil);
    procedure Rotate270(Dst: TCustomBitmap32 = nil);

    procedure ResetClipRect;

    property  Pixel[X, Y: Integer]: TColor32 read GetPixel write SetPixel; default;
    property  PixelS[X, Y: Integer]: TColor32 read GetPixelS write SetPixelS;
    property  PixelW[X, Y: Integer]: TColor32 read GetPixelW write SetPixelW;
    property  PixelX[X, Y: TFixed]: TColor32 read GetPixelX write SetPixelX;
    property  PixelXS[X, Y: TFixed]: TColor32 read GetPixelXS write SetPixelXS;
    property  PixelXW[X, Y: TFixed]: TColor32 read GetPixelXW write SetPixelXW;
    property  PixelF[X, Y: Single]: TColor32 read GetPixelF write SetPixelF;
    property  PixelFS[X, Y: Single]: TColor32 read GetPixelFS write SetPixelFS;
    property  PixelFW[X, Y: Single]: TColor32 read GetPixelFW write SetPixelFW;
    property  PixelFR[X, Y: Single]: TColor32 read GetPixelFR;
    property  PixelXR[X, Y: TFixed]: TColor32 read GetPixelXR;

    property Backend: TCustomBackend read FBackend write SetBackend;

{$IFDEF BITS_GETTER}
    property Bits: PColor32Array read GetBits;
{$ELSE}
    property Bits: PColor32Array read FBits;
{$ENDIF}

    property ClipRect: TRect read FClipRect write SetClipRect;
    property Clipping: Boolean read FClipping;

    property PixelPtr[X, Y: Integer]: PColor32 read GetPixelPtr;
    property ScanLine[Y: Integer]: PColor32Array read GetScanLine;
    property StippleCounter: Single read FStippleCounter write FStippleCounter;
    property StippleStep: Single read FStippleStep write FStippleStep;

    property MeasuringMode: Boolean read FMeasuringMode;
  published
    property DrawMode: TDrawMode read FDrawMode write SetDrawMode default dmOpaque;
    property CombineMode: TCombineMode read FCombineMode write SetCombineMode default cmBlend;
    property WrapMode: TWrapMode read FWrapMode write SetWrapMode default wmClamp;
    property MasterAlpha: Cardinal read FMasterAlpha write SetMasterAlpha default $FF;
    property OuterColor: TColor32 read FOuterColor write FOuterColor default 0;
    property ResamplerClassName: string read GetResamplerClassName write SetResamplerClassName;
    property Resampler: TCustomResampler read FResampler write SetResampler;
    property OnChange;
    property OnPixelCombine: TPixelCombineEvent read FOnPixelCombine write FOnPixelCombine;
    property OnAreaChanged: TAreaChangedEvent read FOnAreaChanged write FOnAreaChanged;
    property OnResize;
  end;

  TCustomBitmap32Class = class of TCustomBitmap32;


  TBitmap32 = class(TCustomBitmap32)
  strict private
    FOnHandleChanged: TNotifyEvent;

    procedure FontChanged(Sender: TObject);
    procedure CanvasChanged(Sender: TObject);
    function GetCanvas: TCanvas;

    function GetBitmapInfo: TBitmapInfo;
    function GetHandle: HBITMAP;
    function GetHDC: HDC;

    function GetFont: TFont;
    procedure SetFont(Value: TFont);
  strict protected
    procedure BackendChangedHandler(Sender: TObject); override;
    procedure BackendChangingHandler(Sender: TObject); override;
    procedure FinalizeBackend; override;
    procedure SetBackend(const ABackend: TCustomBackend); override;

    procedure HandleChanged; virtual;
  protected
    procedure CopyPropertiesTo(Dst: TCustomBitmap32); override;
  public
    class function GetPlatformBackendClass: TCustomBackendClass; override;

  {$IFDEF BCB}
    procedure Draw(const DstRect, SrcRect: TRect; hSrc: Cardinal); overload;
  {$ELSE}
    procedure Draw(const DstRect, SrcRect: TRect; hSrc: HDC); overload;
  {$ENDIF}

{$IFDEF BCB}
    procedure DrawTo(hDst: Cardinal; DstX, DstY: Integer); overload;
    procedure DrawTo(hDst: Cardinal; const DstRect, SrcRect: TRect); overload;
    procedure TileTo(hDst: Cardinal; const DstRect, SrcRect: TRect; MaxTileSize: integer = 1024); overload;
{$ELSE}
    procedure DrawTo(hDst: HDC; DstX: Integer = 0; DstY: Integer = 0); overload;
    procedure DrawTo(hDst: HDC; const DstRect, SrcRect: TRect); overload;
    procedure TileTo(hDst: HDC; const DstRect, SrcRect: TRect; MaxTileSize: integer = 1024); overload;
{$ENDIF}

    procedure DrawTo(Dst: TControlCanvas; DstX: Integer = 0; DstY: Integer = 0); overload;
    procedure DrawTo(Dst: TControlCanvas; const DstRect, SrcRect: TRect); overload;
    procedure TileTo(Dst: TControlCanvas; const DstRect, SrcRect: TRect; MaxTileSize: integer = 1024); overload;

    procedure UpdateFont;
    procedure Textout(X, Y: Integer; const Text: string); overload;
    procedure Textout(X, Y: Integer; const ClipRect: TRect; const Text: string); overload;
    procedure Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string); overload;
    function  TextExtent(const Text: string): TSize;
    function  TextHeight(const Text: string): Integer;
    function  TextWidth(const Text: string): Integer;
    procedure RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32); overload; deprecated 'Use RenderText(...; AntiAlias: boolean) or TCanvas32.RenderText(...) instead';
    procedure RenderText(X, Y: Integer; const Text: string; Color: TColor32; AntiAlias: boolean); overload;
    procedure RenderText(X, Y: Integer; const Text: string; Color: TColor32); overload;

    property  Canvas: TCanvas read GetCanvas;
    function  CanvasAllocated: Boolean;
    procedure DeleteCanvas;

    property Font: TFont read GetFont write SetFont;

    property BitmapHandle: HBITMAP read GetHandle;
    property BitmapInfo: TBitmapInfo read GetBitmapInfo;
    property Handle: HDC read GetHDC;
  published
    property OnHandleChanged: TNotifyEvent read FOnHandleChanged write FOnHandleChanged;
  end;

  { TCustomBackend }
  { This class functions as backend for the TBitmap32 class.
    It manages and provides the backing buffer as well as OS or
    graphics subsystem specific features.}

  TCustomBackend = class(TThreadPersistent)
  strict protected
    FBits: PColor32Array;
    FOwner: TCustomBitmap32;
    FOnChanging: TNotifyEvent;
  protected

    procedure Changing; virtual;
    procedure SetOwner(AOwner: TCustomBitmap32);

{$IFDEF BITS_GETTER}
    function GetBits: PColor32Array; virtual;
{$ENDIF}

    procedure InitializeSurface(NewWidth, NewHeight: Integer; ClearBuffer: Boolean); virtual;
    procedure FinalizeSurface; virtual;
  public
    constructor Create; overload; override;
    constructor Create(Owner: TCustomBitmap32); reintroduce; overload; virtual;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;

    procedure Clear; virtual;
    function Empty: Boolean; virtual;

    procedure ChangeSize(out Width, Height: Integer; NewWidth, NewHeight: Integer; ClearBuffer: Boolean = True); virtual;

{$IFDEF BITS_GETTER}
    property Bits: PColor32Array read GetBits;
{$ELSE}
    property Bits: PColor32Array read FBits;
{$ENDIF}

    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
  end;

  { TCustomSampler }
  TCustomSampler = class(TNotifiablePersistent)
  public
    function GetSampleInt(X, Y: Integer): TColor32; virtual;
    function GetSampleFixed(X, Y: TFixed): TColor32; virtual;
    function GetSampleFloat(X, Y: TFloat): TColor32; virtual;
    procedure PrepareSampling; virtual;
    procedure FinalizeSampling; virtual;
    function HasBounds: Boolean; virtual;
    function GetSampleBounds: TFloatRect; virtual;
  end;


  TPixelAccessMode = (pamUnsafe, pamSafe, pamWrap, pamTransparentEdge);

  { TCustomResampler }
  { Base class for TCustomBitmap32 specific resamplers. }
  TCustomResampler = class(TCustomSampler)
  strict private
    FBitmap: TCustomBitmap32;
    FClipRect: TRect;
    FPixelAccessMode: TPixelAccessMode;
    procedure SetPixelAccessMode(const Value: TPixelAccessMode);
  strict protected
    function GetWidth: TFloat; virtual;
    procedure DoChanged; override;
    property ClipRect: TRect read FClipRect;
  protected
    procedure AssignTo(Dst: TPersistent); override;
    procedure Resample(
      Dst: TCustomBitmap32; DstRect: TRect; DstClip: TRect;
      Src: TCustomBitmap32; SrcRect: TRect;
      CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent); virtual; abstract;
  public
    constructor Create; overload; virtual;
    constructor Create(ABitmap: TCustomBitmap32); overload; virtual;
    procedure PrepareSampling; override;
    function HasBounds: Boolean; override;
    function GetSampleBounds: TFloatRect; override;
    property Bitmap: TCustomBitmap32 read FBitmap write FBitmap;
    property Width: TFloat read GetWidth;
  published
    property PixelAccessMode: TPixelAccessMode read FPixelAccessMode write SetPixelAccessMode default pamSafe;
  end;
  TCustomResamplerClass = class of TCustomResampler;

var
  StockBitmap: TBitmap;

var
  // Default file format version of BMPs written by SaveToStream/SaveToFile.
  DefaultBitmapHeaderVersion: TCustomBitmap32.TInfoHeaderVersion = InfoHeaderVersion4;
  // By default, do not include a color table in BI_BITFIELDS BMPs written by SaveToStream/SaveToFile.
  DefaultBitmapIncludeColorTable: boolean = False;

//------------------------------------------------------------------------------
//
//      Function bindings
//
//------------------------------------------------------------------------------
function GeneralRegistry: TFunctionRegistry;


resourcestring
  RCStrUnmatchedReferenceCounting = 'Unmatched reference counting.';
  RCStrCannotSetSize = 'Can''t set size from ''%s''';
  RCStrInpropriateBackend = 'Inappropriate Backend';

implementation

uses
  GR32.Types.SIMD,
  GR32_Blend,
  GR32_LowLevel,
  GR32_System,
  GR32_Math,
  GR32_Resamplers,
  GR32_Containers,
  GR32_Gamma,
  GR32_Clipboard,
  GR32_Backends,
  GR32_Backends_Generic,
{$if defined(FRAMEWORK_VCL)}
  GR32_Backends_VCL,
{$elseif defined(FRAMEWORK_FMX)}
  GR32_Backends_FMX,
{$elseif defined(FRAMEWORK_LCL)}
  {$IFDEF LCLWin32}
    GR32_Backends_LCL_Win,
  {$ENDIF}
  {$IF defined(LCLGtk) or defined(LCLGtk2)}
    GR32_Backends_LCL_Gtk,
  {$IFEND}
  {$IFDEF LCLCarbon}
    GR32_Backends_LCL_Carbon,
  {$ENDIF}
  {$IFDEF LCLCustomDrawn}
    GR32_Backends_LCL_CustomDrawn,
  {$ENDIF}
{$ifend}
  GR32.ImageFormats,
  GR32.ImageFormats.Default;

type
  { We can not use the Win32 defined records and constants here since we are cross-platform. }

  // Bitmap file and info headers.
  // See : https://docs.microsoft.com/en-us/windows/win32/gdi/bitmap-header-types

  // BMP file header
  TBitmapFileHeader = packed record
    bfType: Word;
    bfSize: DWORD;
    bfReserved1: Word;
    bfReserved2: Word;
    bfOffBits: DWORD;
  end;

  // OS/2 v1 header: BITMAPCOREHEADER
  // Note that this is the only header that isn't compatible with the V1 header
  TBitmapCoreHeader = packed record
    bcSize: DWORD;
    bcWidth: Word;
    bcHeight: Word;
    bcPlanes: Word;
    bcBitCount: Word;
  end;

  // V1 header: BITMAPINFOHEADER
  // All versions after BITMAPINFOHEADER are supersets of BITMAPINFOHEADER.
  // Each new version adds to the one before it.
  TBitmapInfoHeader = packed record
    biSize: DWORD;
    biWidth: Integer;
    biHeight: Integer;
    biPlanes: Word;
    biBitCount: Word;
    biCompression: DWORD;
    biSizeImage: DWORD;
    biXPelsPerMeter: Integer;
    biYPelsPerMeter: Integer;
    biClrUsed: DWORD;
    biClrImportant: DWORD;
  end;

  // OS/2 v2 header - all fields are optional: variable header size!
  TBitmapCoreHeader2 = packed record
    InfoHeader: TBitmapInfoHeader;
    bc2ResUnit: WORD;
    bc2Reserved: WORD;
    bc2Orientation: WORD;
    bc2Halftoning: WORD;
    bc2HalftoneSize1: DWORD;
    bc2HalftoneSize2: DWORD;
    bc2ColorSpace: DWORD;
    bc2AppData: DWORD;
  end;

  // Undocumented V2 header
  TBitmapV2Header = packed record
    InfoHeader: TBitmapInfoHeader;
    bV2RedMask: DWORD;
    bV2GreenMask: DWORD;
    bV2BlueMask: DWORD;
  end;

  // Undocumented V3 header
  TBitmapV3Header = packed record
    InfoHeader: TBitmapInfoHeader;
    bV3RedMask: DWORD;
    bV3GreenMask: DWORD;
    bV3BlueMask: DWORD;
    bV3AlphaMask: DWORD;
  end;

  // V4 header: BITMAPV4HEADER
  TBitmapV4Header = packed record
    bV4Size: DWORD;
    bV4Width: Integer;
    bV4Height: Integer;
    bV4Planes: Word;
    bV4BitCount: Word;
    bV4V4Compression: DWORD;
    bV4SizeImage: DWORD;
    bV4XPelsPerMeter: Integer;
    bV4YPelsPerMeter: Integer;
    bV4ClrUsed: DWORD;
    bV4ClrImportant: DWORD;
    bV4RedMask: DWORD;
    bV4GreenMask: DWORD;
    bV4BlueMask: DWORD;
    bV4AlphaMask: DWORD;
    bV4CSType: DWORD;
    bV4Endpoints: array[0..35] of byte; // TCIEXYZTriple
    bV4GammaRed: DWORD;
    bV4GammaGreen: DWORD;
    bV4GammaBlue: DWORD;
  end;

  // V5 header: BITMAPV5HEADER
  TBitmapV5Header = packed record
    bV5Size: DWORD;
    bV5Width: Integer;
    bV5Height: Integer;
    bV5Planes: Word;
    bV5BitCount: Word;
    bV5Compression: DWORD;
    bV5SizeImage: DWORD;
    bV5XPelsPerMeter: Integer;
    bV5YPelsPerMeter: Integer;
    bV5ClrUsed: DWORD;
    bV5ClrImportant: DWORD;
    bV5RedMask: DWORD;
    bV5GreenMask: DWORD;
    bV5BlueMask: DWORD;
    bV5AlphaMask: DWORD;
    bV5CSType: DWORD;
    bV5Endpoints: array[0..35] of byte; // TCIEXYZTriple
    bV5GammaRed: DWORD;
    bV5GammaGreen: DWORD;
    bV5GammaBlue: DWORD;
    bV5Intent: DWORD;
    bV5ProfileData: DWORD;
    bV5ProfileSize: DWORD;
    bV5Reserved: DWORD;
  end;

  // Just a TBitmapInfoHeader with easy access to the color masks
  TBitmapInfoEx = packed record
    bmiHeader: TBitmapInfoHeader;
    bmiColors: array[0..3] of DWORD;
  end;

  TBitmapHeader = packed record
    FileHeader: TBitmapFileHeader;
    case integer of
    0: (CoreHeader: TBitmapCoreHeader);         // 12 - a.k.a. OS/2 v1
    1: (InfoHeader: TBitmapInfoHeader);         // 40
    2: (V2Header: TBitmapV2Header);             // 52
    3: (V3Header: TBitmapV3Header);             // 56
    4: (V4Header: TBitmapV4Header);             // 108
    5: (V5Header: TBitmapV5Header);             // 124
    6: (CoreHeader2: TBitmapCoreHeader2);       // 16..64
    -1: (Header: TBitmapInfoEx);
  end;

const
  BI_RGB = 0;
  BI_BITFIELDS = 3;

type
  TGraphicAccess = class(TGraphic);

const
  ZERO_RECT: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0) deprecated 'Use Default(TRect) instead';

{ Color construction and conversion functions }

function Color32(WinColor: TColor): TColor32; overload;
begin
  if (WinColor < 0) then
    WinColor := GetSysColor(WinColor and $000000FF);

{$if defined(PUREPASCAL) or defined(TARGET_X64)}
  {$IFNDEF RGBA_FORMAT}
  Result := $FF000000 or ((TColor32(WinColor) and $FF0000) shr 16) or (TColor32(WinColor) and $FF00) or ((TColor32(WinColor) and $FF) shl 16);
  {$ELSE RGBA_FORMAT}
  Result := $FF000000 or (TColor32(WinColor) and $FFFFFF);
  {$ENDIF RGBA_FORMAT}
{$else}
  asm
        MOV     EAX,WinColor
        BSWAP   EAX
        MOV     AL,$FF
        ROR     EAX,8
        MOV     Result,EAX
  end;
{$ifend}
end;

function Color32(R, G, B: Byte; A: Byte = $FF): TColor32; overload;
{$if defined(PUREPASCAL) or defined(TARGET_X64)}
begin
  {$IFNDEF RGBA_FORMAT}
  Result := (A shl 24) or (R shl 16) or (G shl  8) or B;
  {$ELSE RGBA_FORMAT}
  Result := (A shl 24) or (B shl 16) or (G shl  8) or R;
  {$ENDIF RGBA_FORMAT}
{$else}
  asm
        MOV     AH, A
        SHL     EAX, 16
        MOV     AH, DL
        MOV     AL, CL
{$ifend}
end;

function Color32(Index: Byte; var Palette: TPalette32): TColor32; overload;
begin
  Result := Palette[Index];
end;

{$IFNDEF FPC}
function Color32(const AlphaColor: TAlphaColorRec): TColor32;
begin
  TColor32Entry(Result).A := AlphaColor.A;
  TColor32Entry(Result).R := AlphaColor.R;
  TColor32Entry(Result).G := AlphaColor.G;
  TColor32Entry(Result).B := AlphaColor.B;
end;
{$ENDIF}

function Gray32(Intensity: Byte; Alpha: Byte = $FF): TColor32;
begin
  Result := TColor32(Alpha) shl 24 + TColor32(Intensity) shl 16 +
    TColor32(Intensity) shl 8 + TColor32(Intensity);
end;

function WinColor(Color32: TColor32): TColor;
{$IFDEF RGBA_FORMAT}
begin
  Result := Color32 and $00FFFFFF;
end;
{$ELSE RGBA_FORMAT}
{$IF Defined(PUREPASCAL)}
begin
  Result := ((Color32 and $00FF0000) shr 16) or
             (Color32 and $0000FF00) or
            ((Color32 and $000000FF) shl 16);
{$ELSE}
{$IFDEF FPC}assembler; nostackframe;{$ENDIF}
  asm
{$IFDEF TARGET_x64}
        MOV     EAX, ECX
{$ENDIF}
        // the alpha channel byte is set to zero!
        ROL     EAX, 8  // ABGR  ->  BGRA
        XOR     AL, AL  // BGRA  ->  BGR0
        BSWAP   EAX     // BGR0  ->  0RGB
{$IFEND}
end;
{$ENDIF RGBA_FORMAT}

function ArrayOfColor32(const Colors: array of TColor32): TArrayOfColor32;
var
  L: Integer;
begin
  // build a dynamic color array from specified colors
  L := Length(Colors);
  SetLength(Result, L);
  MoveLongword(Colors[0], Result[0], L);
end;

procedure SwapRedBlueMem(var Color32: TColor32);
{$IF Defined(PUREPASCAL)}
var
  Temp: Byte;
begin
  Temp := TColor32Entry(Color32).R;
  TColor32Entry(Color32).R := TColor32Entry(Color32).B;
  TColor32Entry(Color32).B := Temp;
{$ELSE}
  asm
        MOV     EDX, DWORD PTR [Color32]
        ROL     EDX, 8  // ARGB  ->  RGBA
        BSWAP   EDX     // RGBA  ->  ABGR
        MOV     DWORD PTR [Color32], EDX
{$IFEND}
end;

function SwapRedBlue(Color32: TColor32): TColor32;
{$IF Defined(PUREPASCAL)}
begin
  Result := Color32;
  SwapRedBlueMem(Result);
{$ELSE}
  asm
{$IFDEF TARGET_x64}
        MOV     EAX, ECX
{$ENDIF}
        ROL     EAX, 8  // ARGB  ->  RGBA
        BSWAP   EAX     // RGBA  ->  ABGR
{$IFEND}
end;

function Color32ToBGRA(Color32: TColor32): DWORD;
begin
{$IFNDEF RGBA_FORMAT}
  Result := Color32;
{$ELSE RGBA_FORMAT}
  Result := SwapRedBlue(Color32);
{$ENDIF RGBA_FORMAT}
end;

procedure Color32ToBGRAMem(var Color32: TColor32);
begin
{$IFDEF RGBA_FORMAT}
  SwapRedBlueMem(Color32);
{$ENDIF RGBA_FORMAT}
end;

function Color32ToRGBA(Color32: TColor32): DWORD;
begin
{$IFDEF RGBA_FORMAT}
  Result := Color32;
{$ELSE RGBA_FORMAT}
  Result := SwapRedBlue(Color32);
{$ENDIF RGBA_FORMAT}
end;

procedure Color32ToRGBAMem(var Color32: TColor32);
begin
{$IFNDEF RGBA_FORMAT}
  SwapRedBlueMem(Color32);
{$ENDIF RGBA_FORMAT}
end;

function BGRAToColor32(BGRA: DWORD): TColor32;
begin
{$IFNDEF RGBA_FORMAT}
  Result := BGRA;
{$ELSE RGBA_FORMAT}
  Result := SwapRedBlue(BGRA);
{$ENDIF RGBA_FORMAT}
end;

procedure BGRAToColor32Mem(var BGRA: DWORD);
begin
{$IFDEF RGBA_FORMAT}
  SwapRedBlueMem(TColor32(BGRA));
{$ENDIF RGBA_FORMAT}
end;

function RGBAToColor32(RGBA: DWORD): TColor32;
begin
{$IFDEF RGBA_FORMAT}
  Result := RGBA;
{$ELSE RGBA_FORMAT}
  Result := SwapRedBlue(RGBA);
{$ENDIF RGBA_FORMAT}
end;

procedure RGBAToColor32mem(var RGBA: DWORD);
begin
{$IFNDEF RGBA_FORMAT}
  SwapRedBlueMem(TColor32(RGBA));
{$ENDIF RGBA_FORMAT}
end;

procedure Color32ToRGB(Color32: TColor32; var R, G, B: Byte);
begin
{$IFNDEF RGBA_FORMAT}
  R := (Color32 and $00FF0000) shr 16;
  G := (Color32 and $0000FF00) shr 8;
  B := (Color32 and $000000FF);
{$ELSE RGBA_FORMAT}
  R := (Color32 and $000000FF);
  G := (Color32 and $0000FF00) shr 8;
  B := (Color32 and $00FF0000) shr 16;
{$ENDIF RGBA_FORMAT}
end;

procedure Color32ToRGBA(Color32: TColor32; var R, G, B, A: Byte);
begin
{$IFNDEF RGBA_FORMAT}
  A := Color32 shr 24;
  R := (Color32 and $00FF0000) shr 16;
  G := (Color32 and $0000FF00) shr 8;
  B := (Color32 and $000000FF);
{$ELSE RGBA_FORMAT}
  A := Color32 shr 24;
  R := (Color32 and $000000FF);
  G := (Color32 and $0000FF00) shr 8;
  B := (Color32 and $00FF0000) shr 16;
{$ENDIF RGBA_FORMAT}
end;

function Color32Components(R, G, B, A: Boolean): TColor32Components;
const
  ccR : array[Boolean] of TColor32Components = ([], [ccRed]);
  ccG : array[Boolean] of TColor32Components = ([], [ccGreen]);
  ccB : array[Boolean] of TColor32Components = ([], [ccBlue]);
  ccA : array[Boolean] of TColor32Components = ([], [ccAlpha]);
begin
  Result := ccR[R] + ccG[G] + ccB[B] + ccA[A];
end;

function RedComponent(Color32: TColor32): Integer;
begin
{$IFNDEF RGBA_FORMAT}
  Result := (Color32 and $00FF0000) shr 16;
{$ELSE RGBA_FORMAT}
  Result := Color32 and $000000FF;
{$ENDIF RGBA_FORMAT}
end;

function GreenComponent(Color32: TColor32): Integer;
begin
  Result := (Color32 and $0000FF00) shr 8;
end;

function BlueComponent(Color32: TColor32): Integer;
begin
{$IFNDEF RGBA_FORMAT}
  Result := Color32 and $000000FF;
{$ELSE RGBA_FORMAT}
  Result := (Color32 and $00FF0000) shr 16;
{$ENDIF RGBA_FORMAT}
end;

function AlphaComponent(Color32: TColor32): Integer;
begin
  Result := Color32 shr 24;
end;

function Intensity(Color32: TColor32): Integer;
begin
  // (R * 61 + G * 174 + B * 21) / 256
{$IFNDEF RGBA_FORMAT}
  Result := (
    (Color32 and $00FF0000) shr 16 * 61 +
    (Color32 and $0000FF00) shr 8 * 174 +
    (Color32 and $000000FF) * 21
    ) shr 8;
{$ELSE RGBA_FORMAT}
  Result := (
    (Color32 and $000000FF) * 61 +
    (Color32 and $0000FF00) shr 8 * 174 +
    (Color32 and $00FF0000) shr 16 * 21
    ) shr 8;
{$ENDIF RGBA_FORMAT}
end;

function InvertColor(Color32: TColor32): TColor32;
begin
  TColor32Entry(Result).R := $FF - TColor32Entry(Color32).R;
  TColor32Entry(Result).G := $FF - TColor32Entry(Color32).G;
  TColor32Entry(Result).B := $FF - TColor32Entry(Color32).B;
  TColor32Entry(Result).A := TColor32Entry(Color32).A;
end;

function SetAlpha(Color32: TColor32; NewAlpha: Integer): TColor32;
begin
  if NewAlpha < 0 then
    NewAlpha := 0
  else
  if NewAlpha > $FF then
    NewAlpha := $FF;
  Result := (Color32 and $00FFFFFF) or (TColor32(NewAlpha) shl 24);
end;

procedure ModifyAlpha(var Color32: TColor32; NewAlpha: Byte);
begin
  TColor32Entry(Color32).A := NewAlpha;
end;

procedure ScaleAlpha(var Color32: TColor32; Scale: Single);
begin
  TColor32Entry(Color32).A := Round(Scale * TColor32Entry(Color32).A);
end;

{ Color space conversions }

function HSLtoRGB(H, S, L: Single; A: Integer): TColor32;
const
  OneOverThree = 1 / 3;
var
  M1, M2: Single;

  function HueToColor(Hue: Single): Byte;
  var
    V: Double;
  begin
    Hue := Hue - Floor(Hue);
    if 6 * Hue < 1 then
      V := M1 + (M2 - M1) * Hue * 6
    else
    if 2 * Hue < 1 then
      V := M2
    else
    if 3 * Hue < 2 then
      V := M1 + (M2 - M1) * (2 * OneOverThree - Hue) * 6
    else
      V := M1;
    Result := Round($FF * V);
  end;

begin
  if S = 0 then
  begin
    Result := Gray32(Round($FF * L), A);
    Exit;
  end;

  if L <= 0.5 then
    M2 := L * (1 + S)
  else
    M2 := L + S - L * S;
  M1 := 2 * L - M2;
  Result := Color32(
    HueToColor(H + OneOverThree),
    HueToColor(H),
    HueToColor(H - OneOverThree),
    A);
end;

procedure RGBtoHSL(RGB: TColor32; out H, S, L : Single);
const
  // reciprocal mul. opt.
  R6 = 1 / 6;
var
  R, G, B, D, Cmax, Cmin: Single;
begin
  R := RedComponent(RGB) * COne255th;
  G := GreenComponent(RGB) * COne255th;
  B := BlueComponent(RGB) * COne255th;

  Cmax := Max(R, Max(G, B));
  Cmin := Min(R, Min(G, B));
  L := (Cmax + Cmin) * 0.5;

  if Cmax = Cmin then
  begin
    H := 0;
    S := 0
  end else
  begin
    D := Cmax - Cmin;
    if L < 0.5 then
      S := D / (Cmax + Cmin)
    else
      S := D / (2 - Cmax - Cmin);

    if R = Cmax then
      H := (G - B) / D
    else
    if G = Cmax then
      H := 2 + (B - R) / D
    else
      H := 4 + (R - G) / D;

    H := H * R6;

    if H < 0 then
      H := H + 1
  end;
end;

function HSLtoRGB(H, S, L, A: Integer): TColor32;
var
  V, M, M1, M2, VSF: Integer;
begin
  if L <= $7F then
    V := L * (256 + S) shr 8
  else
    V := L + S - Integer(Div255(L * S));
  if V <= 0 then
    Result := Gray32(L, A)
  else
  begin
    M := L * 2 - V;
    H := H * 6;
    VSF := (V - M) * (H and $FF) shr 8;
    M1 := M + VSF;
    M2 := V - VSF;
    case H shr 8 of
      0: Result := Color32(V, M1, M, A);
      1: Result := Color32(M2, V, M, A);
      2: Result := Color32(M, V, M1, A);
      3: Result := Color32(M, M2, V, A);
      4: Result := Color32(M1, M, V, A);
      5: Result := Color32(V, M, M2, A);
    else
      Result := 0;
    end;
  end;
end;

procedure RGBtoHSL(RGB: TColor32; out H, S, L: Byte);
var
  R, G, B, D, Cmax, Cmin, HL: Integer;
begin
  R := RedComponent(RGB);
  G := GreenComponent(RGB);
  B := BlueComponent(RGB);

  Cmax := Max(R, G, B);
  Cmin := Min(R, G, B);
  L := (Cmax + Cmin) shr 1;

  if Cmax = Cmin then
  begin
    H := 0;
    S := 0
  end else
  begin
    D := (Cmax - Cmin) * $FF;
    if L <= $7F then
      S := D div (Cmax + Cmin)
    else
      S := D div ($FF * 2 - Cmax - Cmin);

    D := D * 6;
    if R = Cmax then
      HL := (G - B) * $FF * $FF div D
    else
    if G = Cmax then
      HL := $FF * 2 div 6 + (B - R) * $FF * $FF div D
    else
      HL := $FF * 4 div 6 + (R - G) * $FF * $FF div D;

    if HL < 0 then
      HL := HL + $FF * 2;

    H := HL;
  end;
end;

function HSVtoRGB(H, S, V: Single; A: Integer): TColor32;
var
  Fraction: Single;
  Sel, Q, P: Integer;
begin
  V := 255 * V;

  if S = 0 then
  begin
    Result := Gray32(Trunc(V), A);
    Exit;
  end;

  H := (H - Floor(H)) * 6; // 0 <= H < 6
  Fraction := H - Floor(H);

  Sel := Trunc(H);
  if (Sel mod 2) = 0 then
    Fraction := 1 - Fraction;

  P := Round(V * (1 - S));
  Q := Round(V * (1 - S * Fraction));

  case Sel of
    0: Result := Color32(Trunc(V), Q, P, A);
    1: Result := Color32(Q, Trunc(V), P, A);
    2: Result := Color32(P, Trunc(V), Q, A);
    3: Result := Color32(P, Q, Trunc(V), A);
    4: Result := Color32(Q, P, Trunc(V), A);
    5: Result := Color32(Trunc(V), P, Q, A);
  else
    Result := Gray32(0, A);
  end;
end;

procedure RGBToHSV(Color: TColor32; out H, S, V: Single);
var
  Delta, RGBMin, RGBMax: integer;
  R, G, B: Integer;
const
  COneSixth = 1 / 6;
begin
  R := RedComponent(Color);
  G := GreenComponent(Color);
  B := BlueComponent(Color);

  RGBMin := Min(R, Min(G, B));
  RGBMax := Max(R, Max(G, B));
  V := RGBMax * COne255th;

  Delta := RGBMax - RGBMin;
  if RGBMax = 0 then
    S := 0
  else
    S := Delta / RGBMax;

  if S = 0.0 then
    H := 0
  else
  begin
    if R = RGBMax then
      H := COneSixth * (G - B) / Delta
    else
    if G = RGBMax then
      H := COneSixth * (2 + (B - R) / Delta)
    else
    if B = RGBMax then
      H := COneSixth * (4 + (R - G) / Delta);

    if H < 0.0 then
      H := H + 1;
  end;
end;

{ Palette conversion }

{$IFNDEF RGBA_FORMAT}
function WinPalette(const P: TPalette32): HPALETTE;
var
  L: TMaxLogPalette;
  L0: LOGPALETTE absolute L;
  I: Cardinal;
  Cl: TColor32;
begin
  L.palVersion := $300;
  L.palNumEntries := 256;
  for I := 0 to $FF do
  begin
    Cl := P[I];
    with L.palPalEntry[I] do
    begin
      peFlags := 0;
      peRed := RedComponent(Cl);
      peGreen := GreenComponent(Cl);
      peBlue := BlueComponent(Cl);
    end;
  end;
  Result := CreatePalette(l0);
end;
{$ENDIF RGBA_FORMAT}


{ Fixed-point conversion routines }

function Fixed(S: Single): TFixed;
begin
  Result := Round(S * FixedOne);
end;

function Fixed(I: Integer): TFixed;
begin
  Result := I shl 16;
end;


{ Points }

//------------------------------------------------------------------------------
// TPoint
//------------------------------------------------------------------------------
function Point(X, Y: Integer): TPoint;
begin
  Result.X := X;
  Result.Y := Y;
end;

function Point(const FP: TFloatPoint): TPoint;
begin
  Result.X := Round(FP.X);
  Result.Y := Round(FP.Y);
end;

function Point(const FXP: TFixedPoint): TPoint;
begin
  Result.X := FixedRound(FXP.X);
  Result.Y := FixedRound(FXP.Y);
end;


//------------------------------------------------------------------------------
// TFloatPoint
//------------------------------------------------------------------------------
function FloatPoint(X, Y: Single): TFloatPoint;
begin
  Result.X := X;
  Result.Y := Y;
end;

function FloatPoint(const P: TPoint): TFloatPoint;
begin
  Result.X := P.X;
  Result.Y := P.Y;
end;

function FloatPoint(const FXP: TFixedPoint): TFloatPoint;
begin
  with FXP do
  begin
    Result.X := X * FixedToFloat;
    Result.Y := Y * FixedToFloat;
  end;
end;

{$if not defined(HAS_TPOINTF)}
{$IFDEF RECORD_CONSTRUCTORS}
constructor TFloatPoint.Create(P: TPoint);
begin
  Self.X := P.X;
  Self.Y := P.Y;
end;

constructor TFloatPoint.Create(X, Y: Integer);
begin
  Self.X := X;
  Self.Y := Y;
end;

constructor TFloatPoint.Create(X, Y: TFloat);
begin
  Self.X := X;
  Self.Y := Y;
end;
{$ENDIF}

// operator overloads
class operator TFloatPoint.Equal(const Lhs, Rhs: TFloatPoint): Boolean;
begin
  Result := (Lhs.X = Rhs.X) and (Lhs.Y = Rhs.Y);
end;

class operator TFloatPoint.NotEqual(const Lhs, Rhs: TFloatPoint): Boolean;
begin
  Result := (Lhs.X <> Rhs.X) or (Lhs.Y <> Rhs.Y);
end;

class operator TFloatPoint.Add(const Lhs, Rhs: TFloatPoint): TFloatPoint;
begin
  Result.X := Lhs.X + Rhs.X;
  Result.Y := Lhs.Y + Rhs.Y;
end;

class operator TFloatPoint.Subtract(const Lhs, Rhs: TFloatPoint): TFloatPoint;
begin
  Result.X := Lhs.X - Rhs.X;
  Result.Y := Lhs.Y - Rhs.Y;
end;

class operator TFloatPoint.Explicit(A: TPointF): TFloatPoint;
begin
  Result.X := A.X;
  Result.Y := A.Y;
end;

class operator TFloatPoint.Implicit(A: TPointF): TFloatPoint;
begin
  Result.X := A.X;
  Result.Y := A.Y;
end;

class function TFloatPoint.Zero: TFloatPoint;
begin
  Result := Default(TFloatPoint);
end;
{$ifend}


//------------------------------------------------------------------------------
// TFixedPoint
//------------------------------------------------------------------------------
{$IFDEF RECORD_CONSTRUCTORS}
constructor TFixedPoint.Create(P: TFloatPoint);
begin
  Self.X := Fixed(P.X);
  Self.Y := Fixed(P.Y);
end;

constructor TFixedPoint.Create(X, Y: TFixed);
begin
  Self.X := X;
  Self.Y := Y;
end;

constructor TFixedPoint.Create(X, Y: Integer);
begin
  Self.X := Fixed(X);
  Self.Y := Fixed(Y);
end;

constructor TFixedPoint.Create(X, Y: TFloat);
begin
  Self.X := Fixed(X);
  Self.Y := Fixed(Y);
end;
{$ENDIF}

// operator overloads
class operator TFixedPoint.Equal(const Lhs, Rhs: TFixedPoint): Boolean;
begin
  Result := (Lhs.X = Rhs.X) and (Lhs.Y = Rhs.Y);
end;

class operator TFixedPoint.NotEqual(const Lhs, Rhs: TFixedPoint): Boolean;
begin
  Result := (Lhs.X <> Rhs.X) or (Lhs.Y <> Rhs.Y);
end;

class operator TFixedPoint.Add(const Lhs, Rhs: TFixedPoint): TFixedPoint;
begin
  Result.X := Lhs.X + Rhs.X;
  Result.Y := Lhs.Y + Rhs.Y;
end;

class operator TFixedPoint.Subtract(const Lhs, Rhs: TFixedPoint): TFixedPoint;
begin
  Result.X := Lhs.X - Rhs.X;
  Result.Y := Lhs.Y - Rhs.Y;
end;

class function TFixedPoint.Zero: TFixedPoint;
begin
  Result := Default(TFixedPoint);
end;

function FixedPoint(X, Y: Integer): TFixedPoint; overload;
begin
  Result.X := X shl 16;
  Result.Y := Y shl 16;
end;

function FixedPoint(X, Y: Single): TFixedPoint; overload;
begin
  Result.X := Round(X * FixedOne);
  Result.Y := Round(Y * FixedOne);
end;

function FixedPoint(const P: TPoint): TFixedPoint; overload;
begin
  Result.X := P.X shl 16;
  Result.Y := P.Y shl 16;
end;

function FixedPoint(const FP: TFloatPoint): TFixedPoint; overload;
begin
  Result.X := Round(FP.X * FixedOne);
  Result.Y := Round(FP.Y * FixedOne);
end;


{ Rectangles }

function MakeRect(const L, T, R, B: Integer): TRect;
begin
  with Result do
  begin
    Left := L;
    Top := T;
    Right := R;
    Bottom := B;
  end;
end;

function MakeRect(const FR: TFloatRect; Rounding: TRectRounding): TRect;
begin
  with FR do
    case Rounding of
      rrClosest:
        begin
          Result.Left := System.Round(Left);
          Result.Top := System.Round(Top);
          Result.Right := System.Round(Right);
          Result.Bottom := System.Round(Bottom);
        end;

      rrInside:
        begin
          Result.Left := Ceil(Left);
          Result.Top := Ceil(Top);
          Result.Right := Floor(Right);
          Result.Bottom := Floor(Bottom);
          if Result.Right < Result.Left then Result.Right := Result.Left;
          if Result.Bottom < Result.Top then Result.Bottom := Result.Top;
        end;

      rrOutside:
        begin
          Result.Left := Floor(Left);
          Result.Top := Floor(Top);
          Result.Right := Ceil(Right);
          Result.Bottom := Ceil(Bottom);
        end;
    end;
end;

function MakeRect(const FXR: TFixedRect; Rounding: TRectRounding): TRect;
begin
  with FXR do
    case Rounding of
      rrClosest:
        begin
          Result.Left := FixedRound(Left);
          Result.Top := FixedRound(Top);
          Result.Right := FixedRound(Right);
          Result.Bottom := FixedRound(Bottom);
        end;

      rrInside:
        begin
          Result.Left := FixedCeil(Left);
          Result.Top := FixedCeil(Top);
          Result.Right := FixedFloor(Right);
          Result.Bottom := FixedFloor(Bottom);
          if Result.Right < Result.Left then Result.Right := Result.Left;
          if Result.Bottom < Result.Top then Result.Bottom := Result.Top;
        end;

      rrOutside:
        begin
          Result.Left := FixedFloor(Left);
          Result.Top := FixedFloor(Top);
          Result.Right := FixedCeil(Right);
          Result.Bottom := FixedCeil(Bottom);
        end;
    end;
end;

function FixedRect(const L, T, R, B: TFixed): TFixedRect;
begin
  with Result do
  begin
    Left := L;
    Top := T;
    Right := R;
    Bottom := B;
  end;
end;

function FixedRect(const TopLeft, BottomRight: TFixedPoint): TFixedRect;
begin
  Result.TopLeft := TopLeft;
  Result.BottomRight := BottomRight;
end;

function FixedRect(const ARect: TRect): TFixedRect;
begin
  with Result do
  begin
    Left := ARect.Left shl 16;
    Top := ARect.Top shl 16;
    Right := ARect.Right shl 16;
    Bottom := ARect.Bottom shl 16;
  end;
end;

function FixedRect(const FR: TFloatRect): TFixedRect;
begin
  with Result do
  begin
    Left := Round(FR.Left * 65536);
    Top := Round(FR.Top * 65536);
    Right := Round(FR.Right * 65536);
    Bottom := Round(FR.Bottom * 65536);
  end;
end;

function FloatRect(const L, T, R, B: TFloat): TFloatRect;
begin
  with Result do
  begin
    Left := L;
    Top := T;
    Right := R;
    Bottom := B;
  end;
end;

function FloatRect(const TopLeft, BottomRight: TFloatPoint): TFloatRect;
begin
  Result.TopLeft := TopLeft;
  Result.BottomRight := BottomRight;
end;

function FloatRect(const ARect: TRect): TFloatRect;
begin
  with Result do
  begin
    Left := ARect.Left;
    Top := ARect.Top;
    Right := ARect.Right;
    Bottom := ARect.Bottom;
  end;
end;

function FloatRect(const FXR: TFixedRect): TFloatRect;
begin
  with Result do
  begin
    Left := FXR.Left * FixedToFloat;
    Top := FXR.Top * FixedToFloat;
    Right := FXR.Right * FixedToFloat;
    Bottom := FXR.Bottom * FixedToFloat;
  end;
end;

function IntersectRect(out Dst: TRect; const R1, R2: TRect): Boolean;
begin
  if R1.Left >= R2.Left then
    Dst.Left := R1.Left
  else
    Dst.Left := R2.Left;

  if R1.Right <= R2.Right then
    Dst.Right := R1.Right
  else
    Dst.Right := R2.Right;

  if R1.Top >= R2.Top then
    Dst.Top := R1.Top
  else
    Dst.Top := R2.Top;

  if R1.Bottom <= R2.Bottom then
    Dst.Bottom := R1.Bottom
  else
    Dst.Bottom := R2.Bottom;

  Result := (Dst.Right >= Dst.Left) and (Dst.Bottom >= Dst.Top);

  if not Result then
    Dst := Default(TRect);
end;

function IntersectRect(out Dst: TFloatRect; const FR1, FR2: TFloatRect): Boolean;
begin
  Dst.Left   := Math.Max(FR1.Left,   FR2.Left);
  Dst.Right  := Math.Min(FR1.Right,  FR2.Right);
  Dst.Top    := Math.Max(FR1.Top,    FR2.Top);
  Dst.Bottom := Math.Min(FR1.Bottom, FR2.Bottom);
  Result := (Dst.Right >= Dst.Left) and (Dst.Bottom >= Dst.Top);
  if not Result then
    Dst := Default(TFloatRect);
end;

function IsRectEmpty(const R: TRect): Boolean;
begin
  Result := (R.Right <= R.Left) or (R.Bottom <= R.Top);
end;

function IsRectEmpty(const FR: TFloatRect): Boolean;
begin
  Result := (FR.Right <= FR.Left) or (FR.Bottom <= FR.Top);
end;

function UnionRect(out Rect: TRect; const R1, R2: TRect): Boolean;
begin
  Rect := R1;
  if not IsRectEmpty(R2) then
  begin
    if R2.Left < R1.Left then
      Rect.Left := R2.Left;

    if R2.Top < R1.Top then
      Rect.Top := R2.Top;

    if R2.Right > R1.Right then
      Rect.Right := R2.Right;

    if R2.Bottom > R1.Bottom then
      Rect.Bottom := R2.Bottom;
  end;
  Result := not IsRectEmpty(Rect);
  if not Result then
    Rect := Default(TRect);
end;

function UnionRect(out Rect: TFloatRect; const R1, R2: TFloatRect): Boolean;
begin
  Rect := R1;
  if not IsRectEmpty(R2) then
  begin
    if R2.Left < R1.Left then
      Rect.Left := R2.Left;

    if R2.Top < R1.Top then
      Rect.Top := R2.Top;

    if R2.Right > R1.Right then
      Rect.Right := R2.Right;

    if R2.Bottom > R1.Bottom then
      Rect.Bottom := R2.Bottom;
  end;
  Result := not IsRectEmpty(Rect);
  if not Result then
    Rect := Default(TFloatRect);
end;

function EqualRect(const R1, R2: TRect): Boolean;
begin
  Result := CompareMem(@R1, @R2, SizeOf(TRect));
end;

function EqualRect(const R1, R2: TFloatRect): Boolean;
begin
  Result := CompareMem(@R1, @R2, SizeOf(TFloatRect));
end;

function EqualRectSize(const R1, R2: TRect): Boolean;
begin
  Result := ((R1.Right - R1.Left) = (R2.Right - R2.Left)) and
    ((R1.Bottom - R1.Top) = (R2.Bottom - R2.Top));
end;

function EqualRectSize(const R1, R2: TFloatRect): Boolean;
var
  _R1: TFixedRect;
  _R2: TFixedRect;
begin
  _R1 := FixedRect(R1);
  _R2 := FixedRect(R2);
  Result := ((_R1.Right - _R1.Left) = (_R2.Right - _R2.Left)) and
    ((_R1.Bottom - _R1.Top) = (_R2.Bottom - _R2.Top));
end;

procedure InflateRect(var R: TRect; Dx, Dy: Integer);
begin
  Dec(R.Left, Dx); Dec(R.Top, Dy);
  Inc(R.Right, Dx); Inc(R.Bottom, Dy);
end;

procedure InflateRect(var FR: TFloatRect; Dx, Dy: TFloat);
begin
  with FR do
  begin
    Left := Left - Dx; Top := Top - Dy;
    Right := Right + Dx; Bottom := Bottom + Dy;
  end;
end;

procedure OffsetRect(var R: TRect; Dx, Dy: Integer);
begin
  Inc(R.Left, Dx); Inc(R.Top, Dy);
  Inc(R.Right, Dx); Inc(R.Bottom, Dy);
end;

procedure OffsetRect(var FR: TFloatRect; Dx, Dy: TFloat);
begin
  with FR do
  begin
    Left := Left + Dx; Top := Top + Dy;
    Right := Right + Dx; Bottom := Bottom + Dy;
  end;
end;

function PtInRect(const R: TRect; const P: TPoint): Boolean;
begin
  Result := (P.X >= R.Left) and (P.X < R.Right) and
    (P.Y >= R.Top) and (P.Y < R.Bottom);
end;

function PtInRect(const R: TFloatRect; const P: TPoint): Boolean;
begin
  Result := (P.X >= R.Left) and (P.X < R.Right) and
    (P.Y >= R.Top) and (P.Y < R.Bottom);
end;

function PtInRect(const R: TRect; const P: TFloatPoint): Boolean;
begin
  Result := (P.X >= R.Left) and (P.X < R.Right) and
    (P.Y >= R.Top) and (P.Y < R.Bottom);
end;

function PtInRect(const R: TFloatRect; const P: TFloatPoint): Boolean;
begin
  Result := (P.X >= R.Left) and (P.X < R.Right) and
    (P.Y >= R.Top) and (P.Y < R.Bottom);
end;

//------------------------------------------------------------------------------
// TFloatRect
//------------------------------------------------------------------------------
{$if not defined(HAS_TRECTF)}
class operator TFloatRect.Equal(const Lhs, Rhs: TFloatRect): Boolean;
begin
  // Compare as two 64-bit values
  Result := (PInt64(@Lhs.TopLeft)^ = PInt64(@Rhs.TopLeft)^) and (PInt64(@Lhs.BottomRight)^ = PInt64(@Rhs.BottomRight)^);
end;

class operator TFloatRect.Explicit(const Source: TFloatRect): TRect;
begin
  Result := MakeRect(Source);
end;

class operator TFloatRect.Implicit(const Source: TRect): TFloatRect;
begin
  Result := FloatRect(Source);
end;

class operator TFloatRect.NotEqual(const Lhs, Rhs: TFloatRect): Boolean;
begin
  Result := not(Lhs = Rhs);
end;

procedure TFloatRect.Offset(const Point: TPointF);
begin
  OffsetRect(Self, Point.X, Point.Y);
end;

procedure TFloatRect.Offset(const Point: TPoint);
begin
  OffsetRect(Self, Point.X, Point.Y);
end;

procedure TFloatRect.Offset(const DX, DY: Single);
begin
  OffsetRect(Self, DX, DY);
end;

function TFloatRect.Contains(const R: TRectF): Boolean;
begin
  Result :=
    (Self.Left <= R.Left) and (Self.Right >= R.Right) and
    (Self.Top <= R.Top) and (Self.Bottom >= R.Bottom);
end;

function TFloatRect.Contains(const Pt: TPointF): Boolean;
begin
  Result := PtInRect(Self, Pt);
end;

function TFloatRect.Contains(const Pt: TPoint): Boolean;
begin
  Result := PtInRect(Self, Pt);
end;

procedure TFloatRect.Inflate(const DX, DY: Single);
begin
  InflateRect(Self, DX, DY);
end;

function TFloatRect.GetHeight: TFloat;
begin
  Result := Self.Bottom - Self.Top;
end;

function TFloatRect.GetWidth: TFloat;
begin
  Result := Self.Right - Self.Left;
end;

procedure TFloatRect.SetHeight(const Value: TFloat);
begin
  Self.Bottom := Self.Top + Value;
end;

procedure TFloatRect.SetWidth(const Value: TFloat);
begin
  Self.Right := Self.Left + Value;
end;
{$ifend}


//------------------------------------------------------------------------------
// TFixedRect
//------------------------------------------------------------------------------
class operator TFixedRect.Equal(const Lhs, Rhs: TFixedRect): Boolean;
begin
  // Compare as two 64-bit values
  Result := (PInt64(@Lhs.TopLeft)^ = PInt64(@Rhs.TopLeft)^) and (PInt64(@Lhs.BottomRight)^ = PInt64(@Rhs.BottomRight)^);
end;

class operator TFixedRect.NotEqual(const Lhs, Rhs: TFixedRect): Boolean;
begin
  Result := not(Lhs = Rhs);
end;

class operator TFixedRect.Explicit(const Source: TFixedRect): TFloatRect;
begin
  Result := FloatRect(Source);
end;

class operator TFixedRect.Explicit(const Source: TFixedRect): TRect;
begin
  Result := MakeRect(Source);
end;

class operator TFixedRect.Implicit(const Source: TFloatRect): TFixedRect;
begin
  Result := FixedRect(Source);
end;

class operator TFixedRect.Implicit(const Source: TRect): TFixedRect;
begin
  Result := FixedRect(Source);
end;

function TFixedRect.GetHeight: TFixed;
begin
  Result := Self.Bottom - Self.Top;
end;

function TFixedRect.GetWidth: TFixed;
begin
  Result := Self.Right - Self.Left;
end;

procedure TFixedRect.SetHeight(const Value: TFixed);
begin
  Self.Bottom := Self.Top + Value;
end;

procedure TFixedRect.SetWidth(const Value: TFixed);
begin
  Self.Right := Self.Left + Value;
end;


{ TSimpleInterfacedPersistent }

function TPlainInterfacedPersistent._AddRef: Integer;
begin
  if FRefCounted then
    Result := InterlockedIncrement(FRefCount)
  else
    Result := -1;
end;

function TPlainInterfacedPersistent._Release: Integer;
begin
  if FRefCounted then
  begin
    Result := InterlockedDecrement(FRefCount);
    if Result = 0 then
      Destroy;
  end
  else
    Result := -1;
end;

function TPlainInterfacedPersistent.QueryInterface(
  {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}IID: TGUID; out Obj): HResult;
const
  E_NOINTERFACE = HResult($80004002);
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

procedure TPlainInterfacedPersistent.AfterConstruction;
begin
  inherited;

  // Release the constructor's implicit refcount
  InterlockedDecrement(FRefCount);
end;

procedure TPlainInterfacedPersistent.BeforeDestruction;
begin
  if RefCounted and (RefCount <> 0) then
    raise Exception.Create(RCStrUnmatchedReferenceCounting);

  inherited;
end;

class function TPlainInterfacedPersistent.NewInstance: TObject;
begin
  Result := inherited NewInstance;

  // Set an implicit refcount so that refcounting
  // during construction won't destroy the object.
  TPlainInterfacedPersistent(Result).FRefCount := 1;
end;


{ TNotifiablePersistent }

procedure TNotifiablePersistent.Beforedestruction;
begin
  inherited;
  Inc(FLockUpdateCount);
  Inc(FUpdateCount);
end;

procedure TNotifiablePersistent.BeginLockUpdate;
begin
  Inc(FLockUpdateCount);
end;

procedure TNotifiablePersistent.EndLockUpdate;
begin
  Dec(FLockUpdateCount);
end;

procedure TNotifiablePersistent.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TNotifiablePersistent.EndUpdate;
begin
  Assert(FUpdateCount > 0, 'Unpaired TThreadPersistent.EndUpdate');
  if (FUpdateCount = 1) and (FModified) then
  begin
    try
      DoChanged;
    except
      // Prevent exception from breaking batching
      Dec(FUpdateCount);
      raise;
    end;
    FModified := False;
  end;
  Dec(FUpdateCount);
end;

procedure TNotifiablePersistent.Changed;
begin
  if (FLockUpdateCount > 0) then
    exit;
  BeginUpdate;
  FModified := True;
  EndUpdate;
end;

procedure TNotifiablePersistent.DoChanged;
begin
  if (Assigned(FOnChange)) then
    FOnChange(Self);
end;


{ TThreadPersistent }

constructor TThreadPersistent.Create;
begin
  inherited Create;
  InitializeCriticalSection(FLock);
  // FLock := TCriticalSection.Create;
end;

destructor TThreadPersistent.Destroy;
begin
  DeleteCriticalSection(FLock);
  // FLock.Free;
  inherited;
end;

procedure TThreadPersistent.Lock;
begin
  InterlockedIncrement(FLockCount);
  EnterCriticalSection(FLock);
  // FLock.Enter;
end;

procedure TThreadPersistent.Unlock;
begin
  LeaveCriticalSection(FLock);
  // FLock.Leave;
  InterlockedDecrement(FLockCount);
end;


{ TCustomMap }

constructor TCustomMap.Create(Width, Height: Integer);
begin
  inherited Create;
  SetSize(Width, Height);
end;

destructor TCustomMap.Destroy;
begin
  FOnResize := nil;
  inherited;
end;

procedure TCustomMap.ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer);
begin
  Width := NewWidth;
  Height := NewHeight;
end;

procedure TCustomMap.Delete;
begin
  SetSize(0, 0);
end;

function TCustomMap.Empty: Boolean;
begin
  Result := (Width = 0) or (Height = 0);
end;

procedure TCustomMap.Resized;
begin
  if Assigned(FOnResize) then
    FOnResize(Self);
end;

procedure TCustomMap.SetHeight(NewHeight: Integer);
begin
  SetSize(Width, NewHeight);
end;

function TCustomMap.SetSize(NewWidth, NewHeight: Integer): Boolean;
begin
  if NewWidth < 0 then
    NewWidth := 0;
  if NewHeight < 0 then
    NewHeight := 0;

  Result := (NewWidth <> FWidth) or (NewHeight <> FHeight);

  if Result then
  begin
    BeginUpdate;
    try
      ChangeSize(FWidth, FHeight, NewWidth, NewHeight);
      Changed;
    finally
      EndUpdate;
    end;
    Resized;
  end;
end;

function TCustomMap.SetSizeFrom(Source: TPersistent): Boolean;
begin
  if Source is TCustomMap then
    Result := SetSize(TCustomMap(Source).Width, TCustomMap(Source).Height)
  else
{$ifndef FRAMEWORK_FMX}
  if Source is TGraphic then
    Result := SetSize(TGraphic(Source).Width, TGraphic(Source).Height)
  else
{$else}
  if Source is TBitmap then
    Result := SetSize(TBitmap(Source).Width, TBitmap(Source).Height)
  else
{$endif}
  if Source is TControl then
    Result := SetSize(TControl(Source).Width, TControl(Source).Height)
  else
  if Source = nil then
    Result := SetSize(0, 0)
  else
    raise Exception.CreateFmt(RCStrCannotSetSize, [Source.ClassName]);
end;

procedure TCustomMap.SetWidth(NewWidth: Integer);
begin
  SetSize(NewWidth, Height);
end;


{ TCustomBitmap32 }

constructor TCustomBitmap32.Create(ABackendClass: TCustomBackendClass);
begin
  inherited Create;

  InitializeBackend(ABackendClass);

  FOuterColor := clNone32;  // by default as full transparency black

  FMasterAlpha := $FF;
  FPenColor := clWhite32;
  FStippleStep := 1;
  FCombineMode := cmBlend;
  BlendProc := @BLEND_MEM[FCombineMode]^;
  WrapProcHorz := GetWrapProcEx(WrapMode);
  WrapProcVert := GetWrapProcEx(WrapMode);
  FResampler := TNearestResampler.Create(Self);
end;

constructor TCustomBitmap32.Create;
begin
  Create(GetPlatformBackendClass);
end;

destructor TCustomBitmap32.Destroy;
begin
  BeginLockUpdate;
  Lock;
  try
    FOnAreaChanged := nil; // Avoid notification during destruction
    SetSize(0, 0);
    FResampler.Free;
    FinalizeBackend;
  finally
    Unlock;
  end;
  inherited;
end;

procedure TCustomBitmap32.InitializeBackend(ABackendClass: TCustomBackendClass);
begin
  ABackendClass.Create(Self);
end;

procedure TCustomBitmap32.FinalizeBackend;
begin
  // Drop ownership of backend now:
  // It's a zombie now.
  FBackend.SetOwner(nil);
  FBackend.OnChange := nil;
  FBackend.OnChanging := nil;

  (*
  Release our reference to the backend

  Note: The backend won't necessarily be freed immediately.

  This is required to circumvent a problem with the magic procedure cleanup
  of interfaces that have ref-counting forcefully disabled:

  Quality Central report #9157 and #9500:
  http://qc.codegear.com/wc/qcmain.aspx?d=9157
  http://qc.codegear.com/wc/qcmain.aspx?d=9500

  if any backend interface is used within the same procedure in which
  the owner bitmap is also freed, the magic procedure cleanup will
  clear that particular interface long after the bitmap and its backend
  are gone. This will result in all sorts of madness - mostly heap corruption
  and AVs.

  Here is an example:

  procedure Test;
  var
    MyBitmap: TBitmap32;
  begin
     MyBitmap := TBitmap32.Create;
     MyBitmap.SetSize(100, 100);
     (MyBitmap.Backend as ICanvasSupport).Canvas;
     MyBitmap.Free;
  end; // _IntfClear will try to clear (MyBitmap.Backend as ICanvasSupport)
       // which points to the interface at the previous location of MyBitmap.Backend in memory.
       // MyBitmap.Backend is gone and the _Release call is invalid, so raise hell .

  Here is an example for a correct workaround:

  procedure Test;
  var
    MyBitmap: TBitmap32;
    CanvasIntf: ICanvasSupport;
  begin
    MyBitmap := TBitmap32.Create;
    MyBitmap.SetSize(100, 100);
    CanvasIntf := MyBitmap.Backend as ICanvasSupport;
    CanvasIntf.Canvas;
    CanvasIntf := nil; // this will call _IntfClear and IInterface._Release
    MyBitmap.Free;
  end; // _IntfClear will try to clear CanvasIntf,
       // it's nil, no _Release is called, everything is fine.

  Since the above code is pretty fiddly, we introduce ref-counting for the
  backend. That way the backend will be released once all references are dropped.

  So, release our reference to the backend now:
  *)
  FBackend._Release;
  FBackend := nil;
end;

procedure TCustomBitmap32.SetBackend(const ABackend: TCustomBackend);
begin
  if (ABackend = nil) or (ABackend = FBackend) then
    exit;

  BeginUpdate;
  try

    ABackend.SetOwner(Self);

    if (FBackend <> nil) then
    begin
      ABackend.Assign(FBackend);
      FinalizeBackend;
    end;

    FBackend := ABackend;
    FBackend.OnChange := BackendChangedHandler;
    FBackend.OnChanging := BackendChangingHandler;

    FBackend.Changed;

    Changed;
  finally
    EndUpdate;
  end;
end;

function TCustomBitmap32.ReleaseBackend: TCustomBackend;
begin
  FBackend._AddRef; // Increase ref-count for external use
  Result := FBackend;
end;

function TCustomBitmap32.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;
begin
  Result := FBackend.QueryInterface(IID, Obj);
  if Result <> S_OK then
    Result := inherited QueryInterface(IID, Obj);
end;

procedure TCustomBitmap32.ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer);
begin
  if (Int64(Width) * Int64(Height) * SizeOf(DWORD) > MaxInt) then
    raise EOutOfResources.CreateFmt('Unsupported bitmap size: %d x %d x 4 = %.8X', [Width, Height, Int64(Width) * Int64(Height) * SizeOf(DWORD)]);
  FBackend.ChangeSize(Width, Height, NewWidth, NewHeight);
end;

procedure TCustomBitmap32.BackendChangingHandler(Sender: TObject);
begin
  // descendants can override this method.
end;

procedure TCustomBitmap32.BackendChangedHandler(Sender: TObject);
begin
  FBits := FBackend.Bits;
  ResetClipRect;
end;

function TCustomBitmap32.Empty: Boolean;
begin
  Result := FBackend.Empty or inherited Empty;
end;

procedure TCustomBitmap32.Clear;
begin
  Clear(clBlack32);
end;

procedure TCustomBitmap32.Clear(FillColor: TColor32);
begin
  if Empty then
    Exit;

  if not MeasuringMode then
  begin
    if Clipping then
      FillRect(FClipRect.Left, FClipRect.Top, FClipRect.Right, FClipRect.Bottom, FillColor)
    else
      FillLongword(Bits[0], Width * Height, FillColor);
  end;

  Changed;
end;

procedure TCustomBitmap32.Delete;
begin
  SetSize(0, 0);
end;

procedure TCustomBitmap32.AssignTo(Dst: TPersistent);
begin
  if (not ImageFormatManager.Adapters.AssignTo(Self, Dst)) then
    inherited;
end;

procedure TCustomBitmap32.Assign(Source: TPersistent);
begin
  BeginUpdate;
  try

    if (Source = nil) then
      SetSize(0, 0)
    else
    if (Source is TCustomBitmap32) then
    begin
      TCustomBitmap32(Source).CopyMapTo(Self);
      TCustomBitmap32(Source).CopyPropertiesTo(Self);
    end else
    if (not ImageFormatManager.Adapters.AssignFrom(Self, Source)) then
      inherited; // defer to Source.AssignTo

    Changed;
  finally;
    EndUpdate;
  end;
end;

procedure TCustomBitmap32.CopyMapTo(Dst: TCustomBitmap32);
begin
  Dst.BeginUpdate;
  try
    Dst.SetSize(Width, Height);
    if not Empty then
      MoveLongword(Bits[0], Dst.Bits[0], Width * Height);

    Dst.Changed;
  finally
    Dst.EndUpdate;
  end;
end;

procedure TCustomBitmap32.CopyPropertiesTo(Dst: TCustomBitmap32);
begin
  Dst.DrawMode := DrawMode;
  Dst.CombineMode := CombineMode;
  Dst.WrapMode := WrapMode;
  Dst.MasterAlpha := MasterAlpha;
  Dst.OuterColor := OuterColor;

  Dst.ResamplerClassName := ResamplerClassName;
  if (Dst.Resampler <> nil) and (Resampler <> nil) then
    Dst.Resampler.Assign(Resampler);
end;

constructor TCustomBitmap32.Create(Width, Height: Integer);
begin
  Create;
  SetSize(Width, Height);
end;

{$IFDEF BITS_GETTER}
function TCustomBitmap32.GetBits: PColor32Array;
begin
  Result := FBackend.Bits;
end;
{$ENDIF}

procedure TCustomBitmap32.SetPenPos(const Value: TPoint);
begin
  MoveTo(Value.X, Value.Y);
end;

procedure TCustomBitmap32.SetPenPosF(const Value: TFixedPoint);
begin
  MoveTo(Value.X, Value.Y);
end;

procedure TCustomBitmap32.SetPixel(X, Y: Integer; Value: TColor32);
begin
  Bits[X + Y * Width] := Value;
end;

procedure TCustomBitmap32.SetPixelS(X, Y: Integer; Value: TColor32);
begin
  if {$IFDEF CHANGED_IN_PIXELS}not FMeasuringMode and{$ENDIF}
    (X >= FClipRect.Left) and (X < FClipRect.Right) and
    (Y >= FClipRect.Top) and (Y < FClipRect.Bottom) then
    Bits[X + Y * Width] := Value;

{$IFDEF CHANGED_IN_PIXELS}
  Changed(MakeRect(X, Y, X + 1, Y + 1));
{$ENDIF}
end;

function TCustomBitmap32.GetScanLine(Y: Integer): PColor32Array;
begin
  Result := @Bits[Y * FWidth];
end;

function TCustomBitmap32.GetPenPos: TPoint;
begin
  Result.X := RasterX;
  Result.Y := RasterY;
end;

function TCustomBitmap32.GetPenPosF: TFixedPoint;
begin
  Result.X := RasterXF;
  Result.Y := RasterYF;
end;

function TCustomBitmap32.GetPixel(X, Y: Integer): TColor32;
begin
  Result := Bits[X + Y * Width];
end;

function TCustomBitmap32.GetPixelS(X, Y: Integer): TColor32;
begin
  if (X >= FClipRect.Left) and (X < FClipRect.Right) and
     (Y >= FClipRect.Top) and (Y < FClipRect.Bottom) then
    Result := Bits[X + Y * Width]
  else
    Result := OuterColor;
end;

function TCustomBitmap32.GetPixelPtr(X, Y: Integer): PColor32;
begin
  Result := @Bits[X + Y * Width];
end;

procedure TCustomBitmap32.Draw(DstX, DstY: Integer; Src: TCustomBitmap32);
begin
  if (Src <> nil) then
    Src.DrawTo(Self, DstX, DstY);
end;

procedure TCustomBitmap32.Draw(DstX, DstY: Integer; const SrcRect: TRect;
  Src: TCustomBitmap32);
begin
  if (Src <> nil) then
    Src.DrawTo(Self, DstX, DstY, SrcRect);
end;

procedure TCustomBitmap32.Draw(const DstRect, SrcRect: TRect; Src: TCustomBitmap32);
begin
  if (Src <> nil) then
    Src.DrawTo(Self, DstRect, SrcRect);
end;

procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32);
begin
  BlockTransfer(Dst, 0, 0, Dst.ClipRect, Self, BoundsRect, DrawMode,
    FOnPixelCombine);
end;

procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer);
begin
  BlockTransfer(Dst, DstX, DstY, Dst.ClipRect, Self, BoundsRect, DrawMode,
    FOnPixelCombine);
end;

procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; DstX, DstY: Integer;
    const SrcRect: TRect);
begin
  BlockTransfer(Dst, DstX, DstY, Dst.ClipRect, Self, SrcRect,
    DrawMode, FOnPixelCombine);
end;

procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; const DstRect: TRect);
begin
  StretchTransfer(Dst, DstRect, Dst.ClipRect, Self, BoundsRect, Resampler,
    DrawMode, FOnPixelCombine);
end;

procedure TCustomBitmap32.DrawTo(Dst: TCustomBitmap32; const DstRect,
  SrcRect: TRect);
begin
  StretchTransfer(Dst, DstRect, Dst.ClipRect, Self, SrcRect, Resampler,
    DrawMode, FOnPixelCombine);
end;

procedure TCustomBitmap32.ResetAlpha;
begin
  ResetAlpha($FF);
end;

procedure TCustomBitmap32.ResetAlpha(const AlphaValue: Byte);
var
  I: Integer;
  P: PByteArray;
begin
  if not FMeasuringMode then
  begin
    // Shift the pointer to 'alpha' component of the first pixel
    P := pointer(@PColor32Entry(Bits).A);

{$IFDEF FPC}

    for I := 0 to Width * Height - 1 do
    begin
      P[0] := AlphaValue;
      Inc(P, SizeOf(TColor32));
    end

{$ELSE}

    I := Width * Height;

    if I > 16 then
    begin
      I := I * SizeOf(TColor32) - 16*SizeOf(TColor32);
      Inc(P, I);

      //16x unrolled loop
      I := - I;
      repeat
        P^[I] := AlphaValue;
        P^[I +  4] := AlphaValue;
        P^[I +  8] := AlphaValue;
        P^[I + 12] := AlphaValue;
        P^[I + 16] := AlphaValue;
        P^[I + 20] := AlphaValue;
        P^[I + 24] := AlphaValue;
        P^[I + 28] := AlphaValue;
        P^[I + 32] := AlphaValue;
        P^[I + 36] := AlphaValue;
        P^[I + 40] := AlphaValue;
        P^[I + 44] := AlphaValue;
        P^[I + 48] := AlphaValue;
        P^[I + 52] := AlphaValue;
        P^[I + 56] := AlphaValue;
        P^[I + 60] := AlphaValue;
        Inc(I, 64)
      until I > 0;

      //eventually remaining bits
      Dec(I, 16*SizeOf(TColor32));
      while I < 0 do
      begin
        P^[I + 16*SizeOf(TColor32)] := AlphaValue;
        Inc(I, SizeOf(TColor32));
      end;
    end
    else
    begin
      Dec(I);
      I := I * SizeOf(TColor32);
      while I >= 0 do
      begin
        P^[I] := AlphaValue;
        Dec(I, SizeOf(TColor32));
      end;
    end;

{$ENDIF}
  end;
  Changed;
end;

function TCustomBitmap32.GetPixelB(X, Y: Integer): TColor32;
begin
  // WARNING: this function should never be used on empty bitmaps !!!
  if X < 0 then
    X := 0
  else
  if X >= Width then
    X := Width - 1;

  if Y < 0 then
    Y := 0
  else
  if Y >= Height then
    Y := Height - 1;
  Result := Bits[X + Y * Width];
end;

procedure TCustomBitmap32.SetPixelT(X, Y: Integer; Value: TColor32);
begin
  TBlendMem(BlendProc)(Value, Bits[X + Y * Width]);
end;

procedure TCustomBitmap32.SetPixelT(var Ptr: PColor32; Value: TColor32);
begin
  TBlendMem(BlendProc)(Value, Ptr^);
  Inc(Ptr);
end;

procedure TCustomBitmap32.SetPixelTS(X, Y: Integer; Value: TColor32);
begin
  if {$IFDEF CHANGED_IN_PIXELS}not FMeasuringMode and{$ENDIF}
    (X >= FClipRect.Left) and (X < FClipRect.Right) and
    (Y >= FClipRect.Top) and (Y < FClipRect.Bottom) then
    TBlendMem(BlendProc)(Value, Bits[X + Y * Width]);

{$IFDEF CHANGED_IN_PIXELS}
  Changed(MakeRect(X, Y, X + 1, Y + 1));
{$ENDIF}
end;

procedure TCustomBitmap32.SET_T256(X, Y: Integer; C: TColor32);
var
  flrx, flry, celx, cely: Longword;
  P: PColor32;
  A: TColor32;
begin
  flrx := X and $FF;
  flry := Y and $FF;

{$if defined(PUREPASCAL) or defined(TARGET_X64)}
  X := X div 256;
  Y := Y div 256;
{$else}
  asm
    SAR X, 8
    SAR Y, 8
  end;
{$ifend}

  P := @Bits[X + Y * FWidth];
  if FCombineMode = cmBlend then
  begin
    A := C shr 24;  // opacity
    celx := A * (flrx xor $FF);
    cely := flry xor $FF;
    flrx := A * flrx;
    flry := flry;

    CombineMem(C, P^, celx * cely shr 16); Inc(P);
    CombineMem(C, P^, flrx * cely shr 16); Inc(P, FWidth);
    CombineMem(C, P^, flrx * flry shr 16); Dec(P);
    CombineMem(C, P^, celx * flry shr 16);
  end
  else
  begin
    celx := flrx xor $FF;
    cely := flry xor $FF;
    flrx := flrx;
    flry := flry;

    CombineMem(MergeReg(C, P^), P^, celx * cely shr 8); Inc(P);
    CombineMem(MergeReg(C, P^), P^, flrx * cely shr 8); Inc(P, FWidth);
    CombineMem(MergeReg(C, P^), P^, flrx * flry shr 8); Dec(P);
    CombineMem(MergeReg(C, P^), P^, celx * flry shr 8);
  end;
end;

procedure TCustomBitmap32.SET_TS256(X, Y: Integer; C: TColor32);
var
  flrx, flry, celx, cely: Longword;
  P: PColor32;
  A: TColor32;
begin
  // we're checking against Left - 1 and Top - 1 due to antialiased values...
  if (X < F256ClipRect.Left - 256) or (X >= F256ClipRect.Right) or
     (Y < F256ClipRect.Top - 256) or (Y >= F256ClipRect.Bottom) then Exit;

  flrx := X and $FF;
  flry := Y and $FF;

{$if defined(PUREPASCAL) or defined(TARGET_X64)}
  X := X div 256;
  Y := Y div 256;
{$else}
  asm
    SAR X, 8
    SAR Y, 8
  end;
{$ifend}

  P := @Bits[X + Y * FWidth];
  if FCombineMode = cmBlend then
  begin
    A := C shr 24;  // opacity
    celx := A * (flrx xor $FF);
    cely := flry xor $FF;
    flrx := A * flrx;
    flry := flry;

    if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and
       (X < FClipRect.Right - 1) and (Y < FClipRect.Bottom - 1) then
    begin
      CombineMem(C, P^, celx * cely shr 16); Inc(P);
      CombineMem(C, P^, flrx * cely shr 16); Inc(P, FWidth);
      CombineMem(C, P^, flrx * flry shr 16); Dec(P);
      CombineMem(C, P^, celx * flry shr 16);
    end
    else // "pixel" lies on the edge of the bitmap
    with FClipRect do
    begin
      if (X >= Left) and (Y >= Top) then CombineMem(C, P^, celx * cely shr 16); Inc(P);
      if (X < Right - 1) and (Y >= Top) then CombineMem(C, P^, flrx * cely shr 16); Inc(P, FWidth);
      if (X < Right - 1) and (Y < Bottom - 1) then CombineMem(C, P^, flrx * flry shr 16); Dec(P);
      if (X >= Left) and (Y < Bottom - 1) then CombineMem(C, P^, celx * flry shr 16);
    end;
  end
  else
  begin
    celx := flrx xor $FF;
    cely := flry xor $FF;
    flrx := flrx;
    flry := flry;

    if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and
       (X < FClipRect.Right - 1) and (Y < FClipRect.Bottom - 1) then
    begin
      CombineMem(MergeReg(C, P^), P^, celx * cely shr 8); Inc(P);
      CombineMem(MergeReg(C, P^), P^, flrx * cely shr 8); Inc(P, FWidth);
      CombineMem(MergeReg(C, P^), P^, flrx * flry shr 8); Dec(P);
      CombineMem(MergeReg(C, P^), P^, celx * flry shr 8);
    end
    else // "pixel" lies on the edge of the bitmap
    with FClipRect do
    begin
      if (X >= Left) and (Y >= Top) then CombineMem(MergeReg(C, P^), P^, celx * cely shr 8); Inc(P);
      if (X < Right - 1) and (Y >= Top) then CombineMem(MergeReg(C, P^), P^, flrx * cely shr 8); Inc(P, FWidth);
      if (X < Right - 1) and (Y < Bottom - 1) then CombineMem(MergeReg(C, P^), P^, flrx * flry shr 8); Dec(P);
      if (X >= Left) and (Y < Bottom - 1) then CombineMem(MergeReg(C, P^), P^, celx * flry shr 8);
    end;
  end;
end;

procedure TCustomBitmap32.SetPixelF(X, Y: Single; Value: TColor32);
begin
  SET_T256(Round(X * 256), Round(Y * 256), Value);
end;

procedure TCustomBitmap32.SetPixelX(X, Y: TFixed; Value: TColor32);
begin
  X := (X + $7F) shr 8;
  Y := (Y + $7F) shr 8;
  SET_T256(X, Y, Value);
end;

procedure TCustomBitmap32.SetPixelFS(X, Y: Single; Value: TColor32);
begin
{$IFDEF CHANGED_IN_PIXELS}
  if not FMeasuringMode then
{$ENDIF}
    SET_TS256(Round(X * 256), Round(Y * 256), Value);

{$IFDEF CHANGED_IN_PIXELS}
  Changed(MakeRect(FloatRect(X, Y, X + 1, Y + 1)));
{$ENDIF}
end;

procedure TCustomBitmap32.SetPixelFW(X, Y: Single; Value: TColor32);
begin
{$IFDEF CHANGED_IN_PIXELS}
  if not FMeasuringMode then
{$ENDIF}
    SetPixelXW(Round(X * FixedOne), Round(Y * FixedOne), Value);

{$IFDEF CHANGED_IN_PIXELS}
  Changed(MakeRect(FloatRect(X, Y, X + 1, Y + 1)));
{$ENDIF}
end;

procedure TCustomBitmap32.SetPixelXS(X, Y: TFixed; Value: TColor32);
begin
{$IFDEF CHANGED_IN_PIXELS}
  if not FMeasuringMode then
  begin
{$ENDIF}

{$if defined(PUREPASCAL) or not defined(TARGET_X86)}
    X := (X + $7F) div 256;
    Y := (Y + $7F) div 256;
{$else}
    asm
          ADD X, $7F
          ADD Y, $7F
          SAR X, 8
          SAR Y, 8
    end;
{$ifend}

    SET_TS256(X, Y, Value);

{$IFDEF CHANGED_IN_PIXELS}
  end;
  Changed(MakeRect(X, Y, X + 1, Y + 1));
{$ENDIF}
end;

function TCustomBitmap32.GET_T256(X, Y: Integer): TColor32;
// When using this, remember that it interpolates towards next x and y!
var
  Pos: Integer;
begin
  Pos := (X shr 8) + (Y shr 8) * FWidth;
  Result := Interpolator(X and $FF xor $FF,
                         Y and $FF xor $FF,
                         @Bits[Pos], @Bits[Pos + FWidth]);
end;

function TCustomBitmap32.GET_TS256(X, Y: Integer): TColor32;
begin
  if (X >= F256ClipRect.Left) and (Y >= F256ClipRect.Top) and
     (X < F256ClipRect.Right-256) and (Y < F256ClipRect.Bottom-256) then
    // (x+1, y+1) is inside cliprect
    Result := GET_T256(X,Y)
  else
    // Outside cliprect
    Result := FOuterColor;
end;

function TCustomBitmap32.GetPixelF(X, Y: Single): TColor32;
begin
  Result := GET_T256(Round(X * 256), Round(Y * 256));
end;

function TCustomBitmap32.GetPixelFS(X, Y: Single): TColor32;
begin
  Result := GET_TS256(Round(X * 256), Round(Y * 256));
end;

function TCustomBitmap32.GetPixelFW(X, Y: Single): TColor32;
begin
  Result := GetPixelXW(Round(X * FixedOne), Round(Y * FixedOne));
end;

function TCustomBitmap32.GetPixelX(X, Y: TFixed): TColor32;
begin
  X := (X + $7F) shr 8;
  Y := (Y + $7F) shr 8;
  Result := GET_T256(X, Y);
end;

function TCustomBitmap32.GetPixelXS(X, Y: TFixed): TColor32;
{$if defined(PUREPASCAL) or ((not defined(TARGET_x64)) and (not defined(TARGET_x86)))}
begin
  X := (X + $7F) div 256;
  Y := (Y + $7F) div 256;
  Result := GET_TS256(X, Y);
{$else}
{$IFDEF FPC}assembler;{$ENDIF}
asm
{$IFDEF TARGET_x64}
          PUSH    RBP
          SUB     RSP,$30
          MOV     RBP,RSP
{$ENDIF}
          ADD     X, $7F
          ADD     Y, $7F
          SAR     X, 8
          SAR     Y, 8
          CALL    TCustomBitmap32.GET_TS256

{$IFDEF TARGET_x64}
          LEA     RSP,[RBP+$30]
          POP     RBP
{$ENDIF}

{$ifend}
end;

function TCustomBitmap32.GetPixelFR(X, Y: Single): TColor32;
begin
  Result := FResampler.GetSampleFloat(X, Y);
end;

function TCustomBitmap32.GetPixelXR(X, Y: TFixed): TColor32;
begin
  Result := FResampler.GetSampleFixed(X, Y);
end;

function TCustomBitmap32.GetPixelW(X, Y: Integer): TColor32;
begin
  with FClipRect do
    Result := Bits[FWidth * WrapProcVert(Y, Top, Bottom - 1) + WrapProcHorz(X, Left, Right - 1)];
end;

procedure TCustomBitmap32.SetPixelW(X, Y: Integer; Value: TColor32);
begin
  with FClipRect do
    Bits[FWidth * WrapProcVert(Y, Top, Bottom - 1) + WrapProcHorz(X, Left, Right - 1)] := Value;
end;

function TCustomBitmap32.GetPixelXW(X, Y: TFixed): TColor32;
var
  X1, X2, Y1, Y2 :Integer;
  W: Integer;
begin
  X2 := TFixedRec(X).Int;
  Y2 := TFixedRec(Y).Int;

  with FClipRect do
  begin
    W := Right - 1;
    X1 := WrapProcHorz(X2, Left, W);
    X2 := WrapProcHorz(X2 + 1, Left, W);
    W := Bottom - 1;
    Y1 := WrapProcVert(Y2, Top, W) * Width;
    Y2 := WrapProcVert(Y2 + 1, Top, W) * Width;
  end;

  W := WordRec(TFixedRec(X).Frac).Hi;

  Result := CombineReg(CombineReg(Bits[X2 + Y2], Bits[X1 + Y2], W),
                       CombineReg(Bits[X2 + Y1], Bits[X1 + Y1], W),
                       WordRec(TFixedRec(Y).Frac).Hi);
end;

class function TCustomBitmap32.GetPlatformBackendClass: TCustomBackendClass;
begin
  Result := TMemoryBackend;
end;

procedure TCustomBitmap32.SetPixelXW(X, Y: TFixed; Value: TColor32);
begin
{$if defined(PUREPASCAL) or defined(TARGET_X64)}
  X := (X + $7F) div 256;
  Y := (Y + $7F) div 256;
{$else}
  asm
        ADD X, $7F
        ADD Y, $7F
        SAR X, 8
        SAR Y, 8
  end;
{$ifend}

  with F256ClipRect do
    SET_T256(WrapProcHorz(X, Left, Right - 128), WrapProcVert(Y, Top, Bottom - 128), Value);
end;


procedure TCustomBitmap32.SetStipple(const NewStipple: TArrayOfColor32);
begin
  FStippleCounter := 0;
  FStipplePattern := Copy(NewStipple);
end;

procedure TCustomBitmap32.SetStipple(const NewStipple: array of TColor32);
var
  L: Integer;
begin
  FStippleCounter := 0;
  L := Length(NewStipple);
  SetLength(FStipplePattern, L);
  MoveLongword(NewStipple[0], FStipplePattern[0], L);
end;

procedure TCustomBitmap32.AdvanceStippleCounter(LengthPixels: Single);
var
  L: Integer;
  Delta: Single;
begin
  L := Length(FStipplePattern);
  Delta := LengthPixels * FStippleStep;

  if (L = 0) or (Delta = 0) then
    Exit;

  FStippleCounter := FStippleCounter + Delta;
  FStippleCounter := Wrap(FStippleCounter, L);
end;

{$if defined(PUREPASCAL) or defined(OMIT_SSE2)}

// Just a duplicate of the function below so we at least can get it inlined
function FastPrevWeight(Value: TFloat; PrevIndex: Cardinal): Cardinal; {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := Round($FF * (Value - PrevIndex));
end;

{$else}

var FastPrevWeight: function(Value: TFloat; PrevIndex: Cardinal): Cardinal;

function FastPrevWeight_Pas(Value: TFloat; PrevIndex: Cardinal): Cardinal;
begin
  Result := Round($FF * (Value - PrevIndex));
end;

function FastPrevWeight_SSE41(Value: TFloat; PrevIndex: Cardinal): Cardinal; {$IFDEF FPC} assembler; {$ENDIF}
// Note: roundss is a SSE4.1 instruction
const
  Float255 : TFloat = 255.0;
asm
{$if (not defined(FPC)) and (defined(TARGET_X64))}
        .NOFRAME
{$ifend}

{$if defined(TARGET_x86)}
        MOVSS   xmm0, Value
{$ifend}
        CVTSI2SS xmm1, PrevIndex

        SUBSS   xmm0, xmm1
{$if (not defined(FPC)) or (not defined(TARGET_X64))}
        MULSS   xmm0, DWORD PTR [Float255]
{$else}
        MULSS   xmm0, [rip+Float255].DWORD
{$ifend}

        ROUNDSS xmm0, xmm0, SSE_ROUND.TO_NEAREST_INT + SSE_ROUND.NO_EXC
        CVTSS2SI eax, xmm0
end;

{$ifend}

function TCustomBitmap32.GetStippleColor: TColor32;
var
  L: Integer;
  NextIndex, PrevIndex: Integer;
  PrevWeight: Integer;
begin
  L := Length(FStipplePattern);
  if L = 0 then
  begin
    // no pattern defined, just return something and exit
    Result := clBlack32;
    Exit;
  end;
  WrapMem(FStippleCounter, L);
  // Was: PrevIndex := Round(FStippleCounter - 0.5);
  PrevIndex := FastTrunc(FStippleCounter);
  // Was: PrevWeight= $FF - Round($FF * (FStippleCounter - PrevIndex));
  PrevWeight := $FF - FastPrevWeight(FStippleCounter, PrevIndex);
  if PrevIndex < 0 then
    FStippleCounter := L - 1;
  NextIndex := PrevIndex + 1;
  if NextIndex >= L then
    NextIndex := 0;

  if PrevWeight = $FF then
    Result := FStipplePattern[PrevIndex]
  else
    Result := CombineReg(
      FStipplePattern[PrevIndex],
      FStipplePattern[NextIndex],
      PrevWeight);

  FStippleCounter := FStippleCounter + FStippleStep;
end;

procedure TCustomBitmap32.HorzLine(X1, Y, X2: Integer; Value: TColor32);
begin
  if not FMeasuringMode then
    FillLongword(Bits[X1 + Y * Width], X2 - X1 + 1, Value);

  Changed(MakeRect(X1, Y, X2+1, Y+1)); // Don't indicate that this is a line (AREAINFO_LINE). We want it treated as a rectangle.
end;

procedure TCustomBitmap32.HorzLineS(X1, Y, X2: Integer; Value: TColor32);
begin
  if (Y >= FClipRect.Top) and (Y < FClipRect.Bottom) and TestClip(X1, X2, FClipRect.Left, FClipRect.Right) then
    HorzLine(X1, Y, X2, Value);
end;

procedure TCustomBitmap32.HorzLineT(X1, Y, X2: Integer; Value: TColor32);
var
  i: Integer;
  P: PColor32;
  BlendMem: TBlendMem;
begin
  if X2 < X1 then
    Exit;

  if not FMeasuringMode then
  begin
    P := PixelPtr[X1, Y];
    BlendMem := TBlendMem(BlendProc);
    for i := X1 to X2 do
    begin
      BlendMem(Value, P^);
      Inc(P);
    end;
  end;

  Changed(MakeRect(X1, Y, X2+1, Y+1)); // Don't indicate that this is a line (AREAINFO_LINE). We want it treated as a rectangle.
end;

procedure TCustomBitmap32.HorzLineTS(X1, Y, X2: Integer; Value: TColor32);
begin
  if (Y >= FClipRect.Top) and (Y < FClipRect.Bottom) and TestClip(X1, X2, FClipRect.Left, FClipRect.Right) then
    HorzLineT(X1, Y, X2, Value);
end;

procedure TCustomBitmap32.HorzLineTSP(X1, Y, X2: Integer);
var
  I, N: Integer;
begin
  if Empty then
    Exit;

  if (Y >= FClipRect.Top) and (Y < FClipRect.Bottom) then
  begin
    if ((X1 < FClipRect.Left) and (X2 < FClipRect.Left)) or
       ((X1 >= FClipRect.Right) and (X2 >= FClipRect.Right)) then
    begin
      if not FMeasuringMode then
        AdvanceStippleCounter(Abs(X2 - X1) + 1);

      Exit;
    end;

    if X1 < FClipRect.Left then
    begin
      if not FMeasuringMode then
        AdvanceStippleCounter(FClipRect.Left - X1);

      X1 := FClipRect.Left;
    end else
    if X1 >= FClipRect.Right then
    begin
      if not FMeasuringMode then
        AdvanceStippleCounter(X1 - (FClipRect.Right - 1));

      X1 := FClipRect.Right - 1;
    end;

    N := 0;
    if X2 < FClipRect.Left then
    begin
      N := FClipRect.Left - X2;
      X2 := FClipRect.Left;
    end else
    if X2 >= FClipRect.Right then
    begin
      N := X2 - (FClipRect.Right - 1);
      X2 := FClipRect.Right - 1;
    end;

    if not FMeasuringMode then
    begin
      if X2 >= X1 then
      begin
        for I := X1 to X2 do
          SetPixelT(I, Y, GetStippleColor);
      end else
      begin
        for I := X1 downto X2 do
          SetPixelT(I, Y, GetStippleColor);
      end;
    end;

    Changed(MakeRect(X1, Y, X2+1, Y+1)); // Don't indicate that this is a line (AREAINFO_LINE). We want it treated as a rectangle.

    if (not FMeasuringMode) and (N > 0) then
      AdvanceStippleCounter(N);
  end else
  if not FMeasuringMode then
    AdvanceStippleCounter(Abs(X2 - X1) + 1);
end;

procedure TCustomBitmap32.HorzLineX(X1, Y, X2: TFixed; Value: TColor32);
//Author: Michael Hansen
var
  I: Integer;
  X1F, X2F, YF, Count: Integer;
  Wx1, Wx2, Wy, Wt: TColor32;
  PDst: PColor32;
begin
  if X1 > X2 then
    Swap(X1, X2);

  if not FMeasuringMode then
  begin
    X1F := X1 shr 16;
    X2F := X2 shr 16;
    YF := Y shr 16;

    PDst := PixelPtr[X1F, YF];

    Wy := Y and $ffff xor $ffff;
    Wx1 := X1 and $ffff xor $ffff;
    Wx2 := X2 and $ffff;

    Count := X2F - X1F - 1;
    if Wy > 0 then
    begin
      CombineMem(Value, PDst^, (Wy * Wx1) shr 24);
      Inc(PDst);

      Wt := Wy shr 8;

      for I := 0 to Count - 1 do
      begin
        CombineMem(Value, PDst^, Wt);
        Inc(PDst);
      end;

      CombineMem(Value, PDst^, (Wy * Wx2) shr 24);
    end;

    PDst := PixelPtr[X1F, YF + 1];

    Wy := Wy xor $ffff;
    if Wy > 0 then
    begin
      CombineMem(Value, PDst^, (Wy * Wx1) shr 24);
      Inc(PDst);

      Wt := Wy shr 8;

      for I := 0 to Count - 1 do
      begin
        CombineMem(Value, PDst^, Wt);
        Inc(PDst);
      end;

      CombineMem(Value, PDst^, (Wy * Wx2) shr 24);
    end;
  end;

  Changed(MakeRect(FixedRect(X1, Y, X2+1, Y+1), rrOutside), AREAINFO_LINE + 2);
end;

procedure TCustomBitmap32.HorzLineXS(X1, Y, X2: TFixed; Value: TColor32);
//author: Michael Hansen
begin
  if X1 > X2 then
    Swap(X1, X2);

  X1 := Constrain(X1, FFixedClipRect.Left, FFixedClipRect.Right);
  X2 := Constrain(X2, FFixedClipRect.Left, FFixedClipRect.Right);

  if (Abs(X2 - X1) > FIXEDONE) and InRange(Y, FFixedClipRect.Top, FFixedClipRect.Bottom - FIXEDONE) then
    HorzLineX(X1, Y, X2, Value)
  else
    LineXS(X1, Y, X2, Y, Value);
end;

procedure TCustomBitmap32.VertLine(X, Y1, Y2: Integer; Value: TColor32);
var
  I, NH, NL: Integer;
  P: PColor32;
begin
  if Y2 < Y1 then
    Exit;

  if not FMeasuringMode then
  begin
    P := PixelPtr[X, Y1];
    I := Y2 - Y1 + 1;
    NH := I shr 2;
    NL := I and $03;

    for I := 0 to NH - 1 do
    begin
      P^ := Value; Inc(P, Width);
      P^ := Value; Inc(P, Width);
      P^ := Value; Inc(P, Width);
      P^ := Value; Inc(P, Width);
    end;

    for I := 0 to NL - 1 do
    begin
      P^ := Value; Inc(P, Width);
    end;

  end;

  Changed(MakeRect(X, Y1, X+1, Y2+1)); // Don't indicate that this is a line (AREAINFO_LINE). We want it treated as a rectangle.
end;

procedure TCustomBitmap32.VertLineS(X, Y1, Y2: Integer; Value: TColor32);
begin
  if (X >= FClipRect.Left) and (X < FClipRect.Right) and TestClip(Y1, Y2, FClipRect.Top, FClipRect.Bottom) then
    VertLine(X, Y1, Y2, Value);
end;

procedure TCustomBitmap32.VertLineT(X, Y1, Y2: Integer; Value: TColor32);
var
  i: Integer;
  P: PColor32;
  BlendMem: TBlendMem;
begin
  if not FMeasuringMode then
  begin
    P := PixelPtr[X, Y1];
    BlendMem := TBlendMem(BlendProc);

    for i := Y1 to Y2 do
    begin
      BlendMem(Value, P^);
      Inc(P, Width);
    end;
  end;

  Changed(MakeRect(X, Y1, X+1, Y2+1)); // Don't indicate that this is a line (AREAINFO_LINE). We want it treated as a rectangle.
end;

procedure TCustomBitmap32.VertLineTS(X, Y1, Y2: Integer; Value: TColor32);
begin
  if (X >= FClipRect.Left) and (X < FClipRect.Right) and TestClip(Y1, Y2, FClipRect.Top, FClipRect.Bottom) then
    VertLineT(X, Y1, Y2, Value);
end;

procedure TCustomBitmap32.VertLineTSP(X, Y1, Y2: Integer);
var
  I, N: Integer;
begin
  if Empty then
    Exit;

  if (X >= FClipRect.Left) and (X < FClipRect.Right) then
  begin
    if ((Y1 < FClipRect.Top) and (Y2 < FClipRect.Top)) or
       ((Y1 >= FClipRect.Bottom) and (Y2 >= FClipRect.Bottom)) then
    begin
      if not FMeasuringMode then
        AdvanceStippleCounter(Abs(Y2 - Y1) + 1);

      Exit;
    end;

    if Y1 < FClipRect.Top then
    begin
      if not FMeasuringMode then
        AdvanceStippleCounter(FClipRect.Top - Y1);

      Y1 := FClipRect.Top;
    end else
    if Y1 >= FClipRect.Bottom then
    begin
      if not FMeasuringMode then
        AdvanceStippleCounter(Y1 - (FClipRect.Bottom - 1));

      Y1 := FClipRect.Bottom - 1;
    end;

    N := 0;
    if Y2 < FClipRect.Top then
    begin
      N := FClipRect.Top - Y2;
      Y2 := FClipRect.Top;
    end else
    if Y2 >= FClipRect.Bottom then
    begin
      N := Y2 - (FClipRect.Bottom - 1);
      Y2 := FClipRect.Bottom - 1;
    end;

    if not FMeasuringMode then
    begin
      if Y2 >= Y1 then
      begin
        for I := Y1 to Y2 do
          SetPixelT(X, I, GetStippleColor)
      end else
      begin
        for I := Y1 downto Y2 do
          SetPixelT(X, I, GetStippleColor);
      end;
    end;

    Changed(MakeRect(X, Y1, X+1, Y2+1)); // Don't indicate that this is a line (AREAINFO_LINE). We want it treated as a rectangle.

    if (not FMeasuringMode) and (N > 0) then
      AdvanceStippleCounter(N);
  end else
  if not FMeasuringMode then
    AdvanceStippleCounter(Abs(Y2 - Y1) + 1);
end;

procedure TCustomBitmap32.VertLineX(X, Y1, Y2: TFixed; Value: TColor32);
//Author: Michael Hansen
var
  I: Integer;
  Y1F, Y2F, XF, Count: Integer;
  Wy1, Wy2, Wx, Wt: TColor32;
  PDst: PColor32;
begin
  if Y1 > Y2 then
    Swap(Y1, Y2);

  if not FMeasuringMode then
  begin
    Y1F := Y1 shr 16;
    Y2F := Y2 shr 16;
    XF := X shr 16;

    PDst := PixelPtr[XF, Y1F];

    Wx := X and $ffff xor $ffff;
    Wy1 := Y1 and $ffff xor $ffff;
    Wy2 := Y2 and $ffff;

    Count := Y2F - Y1F - 1;
    if Wx > 0 then
    begin
      CombineMem(Value, PDst^, (Wx * Wy1) shr 24);
      Inc(PDst, FWidth);

      Wt := Wx shr 8;

      for I := 0 to Count - 1 do
      begin
        CombineMem(Value, PDst^, Wt);
        Inc(PDst, FWidth);
      end;

      CombineMem(Value, PDst^, (Wx * Wy2) shr 24);
    end;

    PDst := PixelPtr[XF + 1, Y1F];

    Wx := Wx xor $ffff;
    if Wx > 0 then
    begin
      CombineMem(Value, PDst^, (Wx * Wy1) shr 24);
      Inc(PDst, FWidth);

      Wt := Wx shr 8;

      for I := 0 to Count - 1 do
      begin
        CombineMem(Value, PDst^, Wt);
        Inc(PDst, FWidth);
      end;

      CombineMem(Value, PDst^, (Wx * Wy2) shr 24);
    end;
  end;

  Changed(MakeRect(FixedRect(X, Y1, X+1, Y2+1), rrOutside), AREAINFO_LINE + 2);
end;

procedure TCustomBitmap32.VertLineXS(X, Y1, Y2: TFixed; Value: TColor32);
//author: Michael Hansen
begin
  if Y1 > Y2 then
    Swap(Y1, Y2);

  Y1 := Constrain(Y1, FFixedClipRect.Top, FFixedClipRect.Bottom - FIXEDONE);
  Y2 := Constrain(Y2, FFixedClipRect.Top, FFixedClipRect.Bottom - FIXEDONE);

  if (Abs(Y2 - Y1) > FIXEDONE) and InRange(X, FFixedClipRect.Left, FFixedClipRect.Right - FIXEDONE) then
    VertLineX(X, Y1, Y2, Value)
  else
    LineXS(X, Y1, X, Y2, Value);
end;

procedure TCustomBitmap32.Line(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean);
var
  Dy, Dx, Sy, Sx, I, Delta: Integer;
  P: PColor32;
begin
  Dx := X2 - X1;
  Dy := Y2 - Y1;

  if Dx > 0 then
    Sx := 1
  else
  if Dx < 0 then
  begin
    Dx := -Dx;
    Sx := -1;
  end else // Dx = 0
  begin
    if Dy > 0 then
      VertLine(X1, Y1, Y2 - 1, Value)
    else
    if Dy < 0 then
      VertLine(X1, Y2 + 1, Y1, Value);

    if L then
    begin
      if not FMeasuringMode then
        Pixel[X2, Y2] := Value;
      Changed(MakeRect(X2, Y2, X2+1, Y2+1));
    end;

    Exit;
  end;

  if Dy > 0 then
    Sy := 1
  else
  if Dy < 0 then
  begin
    Dy := -Dy;
    Sy := -1;
  end else // Dy = 0
  begin
    if X2 > X1 then
      HorzLine(X1, Y1, X2 - 1, Value)
    else
      HorzLine(X2 + 1, Y1, X1, Value);

    if L then
    begin
      if not FMeasuringMode then
        Pixel[X2, Y2] := Value;
      Changed(MakeRect(X2, Y2, X2+1, Y2+1));
    end;

    Exit;
  end;

  if not FMeasuringMode then
  begin
    P := PixelPtr[X1, Y1];
    Sy := Sy * Width;

    if Dx > Dy then
    begin
      Delta := Dx shr 1;

      for I := 0 to Dx - 1 do
      begin
        P^ := Value;
        Inc(P, Sx);
        Inc(Delta, Dy);

        if Delta >= Dx then
        begin
          Inc(P, Sy);
          Dec(Delta, Dx);
        end;
      end;
    end else // Dx < Dy
    begin
      Delta := Dy shr 1;

      for I := 0 to Dy - 1 do
      begin
        P^ := Value;
        Inc(P, Sy);
        Inc(Delta, Dx);

        if Delta >= Dy then
        begin
          Inc(P, Sx);
          Dec(Delta, Dy);
        end;
      end;
    end;

    if L then
      P^ := Value;
  end;

  Changed(MakeRect(X1, Y1, X2, Y2), AREAINFO_LINE + 1);
end;

procedure TCustomBitmap32.LineS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean);
var
  Dx2, Dy2,Cx1, Cx2, Cy1, Cy2, PI, Sx, Sy, Dx, Dy, xd, yd, rem, term, e: Integer;
  OC: Int64;
  Swapped, CheckAux: Boolean;
  P: PColor32;
  ChangedRect: TRect;
begin
  ChangedRect := MakeRect(X1, Y1, X2, Y2);

  if not FMeasuringMode then
  begin
    Dx := X2 - X1; Dy := Y2 - Y1;

    // check for trivial cases...
    if Dx = 0 then // vertical line?
    begin
      if Dy > 0 then
        VertLineS(X1, Y1, Y2 - 1, Value)
      else
      if Dy < 0 then
        VertLineS(X1, Y2 + 1, Y1, Value);

      if L then
      begin
        PixelS[X2, Y2] := Value;
        Changed(MakeRect(X2, Y2, X2+1, Y2+1));
      end;

      Exit;
    end else
    if Dy = 0 then // horizontal line?
    begin
      if Dx > 0 then
        HorzLineS(X1, Y1, X2 - 1, Value)
      else
      if Dx < 0 then
        HorzLineS(X2 + 1, Y1, X1, Value);

      if L then
      begin
        PixelS[X2, Y2] := Value;
        Changed(MakeRect(X2, Y2, X2+1, Y2+1));
      end;

      Exit;
    end;

    Cx1 := FClipRect.Left; Cx2 := FClipRect.Right - 1;
    Cy1 := FClipRect.Top;  Cy2 := FClipRect.Bottom - 1;

    if Dx > 0 then
    begin
      if (X1 > Cx2) or (X2 < Cx1) then
        Exit; // segment not visible

      Sx := 1;
    end else
    begin
      if (X2 > Cx2) or (X1 < Cx1)
        then Exit; // segment not visible

      Sx := -1;
      X1 := -X1;   X2 := -X2;   Dx := -Dx;
      Cx1 := -Cx1; Cx2 := -Cx2;
      Swap(Cx1, Cx2);
    end;

    if Dy > 0 then
    begin
      if (Y1 > Cy2) or (Y2 < Cy1) then
        Exit; // segment not visible

      Sy := 1;
    end else
    begin
      if (Y2 > Cy2) or (Y1 < Cy1) then
        Exit; // segment not visible

      Sy := -1;
      Y1 := -Y1;   Y2 := -Y2;   Dy := -Dy;
      Cy1 := -Cy1; Cy2 := -Cy2;
      Swap(Cy1, Cy2);
    end;

    if Dx < Dy then
    begin
      Swapped := True;
      Swap(X1, Y1); Swap(X2, Y2); Swap(Dx, Dy);
      Swap(Cx1, Cy1); Swap(Cx2, Cy2); Swap(Sx, Sy);
    end else
      Swapped := False;

    // Bresenham's set up:
    Dx2 := Dx shl 1; Dy2 := Dy shl 1;
    xd := X1; yd := Y1; e := Dy2 - Dx; term := X2;
    CheckAux := True;

    // Clipping rect horizontal entry
    if Y1 < Cy1 then
    begin
      OC := Int64(Dx2) * (Cy1 - Y1) - Dx;
      Inc(xd, OC div Dy2);
      rem := OC mod Dy2;

      if xd > Cx2 then
        Exit;

      if xd >= Cx1 then
      begin
        yd := Cy1;
        Dec(e, rem + Dx);

        if rem > 0 then
        begin
          Inc(xd);
          Inc(e, Dy2);
        end;
        CheckAux := False; // to avoid ugly goto we set this to omit the next check
      end;
    end;

    // clipping rect vertical entry
    if CheckAux and (X1 < Cx1) then
    begin
      OC := Int64(Dy2) * (Cx1 - X1);
      Inc(yd, OC div Dx2);
      rem := OC mod Dx2;

      if (yd > Cy2) or (yd = Cy2) and (rem >= Dx) then
        Exit;

      xd := Cx1;
      Inc(e, rem);

      if (rem >= Dx) then
      begin
        Inc(yd);
        Dec(e, Dx2);
      end;
    end;

    // set auxiliary var to indicate that term is not clipped, since
    // term still has the unclipped value assigned at setup.
    CheckAux := False;

    // is the segment exiting the clipping rect?
    if Y2 > Cy2 then
    begin
      OC := Int64(Dx2) * (Cy2 - Y1) + Dx;
      term := X1 + OC div Dy2;
      rem := OC mod Dy2;

      if rem = 0 then
        Dec(term);

      CheckAux := True; // set auxiliary var to indicate that term is clipped
    end;

    if term > Cx2 then
    begin
      term := Cx2;
      CheckAux := True; // set auxiliary var to indicate that term is clipped
    end;

    Inc(term);

    if Sy = -1 then
      yd := -yd;

    if Sx = -1 then
    begin
      xd := -xd;
      term := -term;
    end;

    Dec(Dx2, Dy2);

    if Swapped then
    begin
      PI := Sx * Width;
      P := @Bits[yd + xd * Width];
    end else
    begin
      PI := Sx;
      Sy := Sy * Width;
      P := @Bits[xd + yd * Width];
    end;

    // do we need to skip the last pixel of the line and is term not clipped?
    if not(L or CheckAux) then
    begin
      if xd < term then
        Dec(term)
      else
        Inc(term);
    end;

    while xd <> term do
    begin
      Inc(xd, Sx);

      P^ := Value;
      Inc(P, PI);
      if e >= 0 then
      begin
        Inc(P, Sy);
        Dec(e, Dx2);
      end else
        Inc(e, Dy2);
    end;
  end;

  Changed(ChangedRect, AREAINFO_LINE + 1);
end;

procedure TCustomBitmap32.LineT(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean);
var
  Dy, Dx, Sy, Sx, I, Delta: Integer;
  P: PColor32;
  BlendMem: TBlendMem;
  ChangedRect: TRect;
begin
  ChangedRect := MakeRect(X1, Y1, X2, Y2);

  if not FMeasuringMode then
  begin
    Dx := X2 - X1;
    Dy := Y2 - Y1;

    if Dx > 0 then
      Sx := 1
    else
    if Dx < 0 then
    begin
      Dx := -Dx;
      Sx := -1;
    end else // Dx = 0
    begin
      if Dy > 0 then
        VertLineT(X1, Y1, Y2 - 1, Value)
      else
      if Dy < 0 then
        VertLineT(X1, Y2 + 1, Y1, Value);

      if L then
      begin
        SetPixelT(X2, Y2, Value);
        Changed(MakeRect(X2, Y2, X2+1, Y2+1));
      end;

      Exit;
    end;

    if Dy > 0 then
      Sy := 1
    else
    if Dy < 0 then
    begin
      Dy := -Dy;
      Sy := -1;
    end else // Dy = 0
    begin
      if X2 > X1 then
        HorzLineT(X1, Y1, X2 - 1, Value)
      else
        HorzLineT(X2 + 1, Y1, X1, Value);

      if L then
      begin
        SetPixelT(X2, Y2, Value);
        Changed(MakeRect(X2, Y2, X2+1, Y2+1));
      end;

      Exit;
    end;

    P := PixelPtr[X1, Y1];
    Sy := Sy * Width;

    BlendMem := TBlendMem(BlendProc);

    if Dx > Dy then
    begin
      Delta := Dx shr 1;

      for I := 0 to Dx - 1 do
      begin
        BlendMem(Value, P^);

        Inc(P, Sx);
        Inc(Delta, Dy);
        if Delta >= Dx then
        begin
          Inc(P, Sy);
          Dec(Delta, Dx);
        end;
      end;
    end else // Dx < Dy
    begin
      Delta := Dy shr 1;

      for I := 0 to Dy - 1 do
      begin
        BlendMem(Value, P^);

        Inc(P, Sy);
        Inc(Delta, Dx);
        if Delta >= Dy then
        begin
          Inc(P, Sx);
          Dec(Delta, Dy);
        end;
      end;
    end;

    if L then
      BlendMem(Value, P^);
  end;

  Changed(ChangedRect, AREAINFO_LINE + 1);
end;

procedure TCustomBitmap32.LineTS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean);
var
  Cx1, Cx2, Cy1, Cy2, PI, Sx, Sy, Dx, Dy, xd, yd, Dx2, Dy2, rem, term, e: Integer;
  OC: Int64;
  Swapped, CheckAux: Boolean;
  P: PColor32;
  BlendMem: TBlendMem;
  ChangedRect: TRect;
begin
  ChangedRect := MakeRect(X1, Y1, X2, Y2);

  if not FMeasuringMode then
  begin
    Dx := X2 - X1; Dy := Y2 - Y1;

    // check for trivial cases...
    if Dx = 0 then // vertical line?
    begin
      if Dy > 0 then
        VertLineTS(X1, Y1, Y2 - 1, Value)
      else
      if Dy < 0 then
        VertLineTS(X1, Y2 + 1, Y1, Value);

      if L then
      begin
        SetPixelTS(X2, Y2, Value);
        Changed(MakeRect(X2, Y2, X2+1, Y2+1));
      end;

      Exit;
    end else
    if Dy = 0 then // horizontal line?
    begin
      if Dx > 0 then
        HorzLineTS(X1, Y1, X2 - 1, Value)
      else
      if Dx < 0 then
        HorzLineTS(X2 + 1, Y1, X1, Value);

      if L then
      begin
        SetPixelTS(X2, Y2, Value);
        Changed(MakeRect(X2, Y2, X2+1, Y2+1));
      end;

      Exit;
    end;

    Cx1 := FClipRect.Left; Cx2 := FClipRect.Right - 1;
    Cy1 := FClipRect.Top;  Cy2 := FClipRect.Bottom - 1;

    if Dx > 0 then
    begin
      if (X1 > Cx2) or (X2 < Cx1) then
        Exit; // segment not visible

      Sx := 1;
    end else
    begin
      if (X2 > Cx2) or (X1 < Cx1) then
        Exit; // segment not visible

      Sx := -1;
      X1 := -X1;   X2 := -X2;   Dx := -Dx;
      Cx1 := -Cx1; Cx2 := -Cx2;
      Swap(Cx1, Cx2);
    end;

    if Dy > 0 then
    begin
      if (Y1 > Cy2) or (Y2 < Cy1) then
        Exit; // segment not visible

      Sy := 1;
    end else
    begin
      if (Y2 > Cy2) or (Y1 < Cy1) then
        Exit; // segment not visible

      Sy := -1;
      Y1 := -Y1;   Y2 := -Y2;   Dy := -Dy;
      Cy1 := -Cy1; Cy2 := -Cy2;
      Swap(Cy1, Cy2);
    end;

    if Dx < Dy then
    begin
      Swapped := True;
      Swap(X1, Y1); Swap(X2, Y2); Swap(Dx, Dy);
      Swap(Cx1, Cy1); Swap(Cx2, Cy2); Swap(Sx, Sy);
    end else
      Swapped := False;

    // Bresenham's set up:
    Dx2 := Dx shl 1; Dy2 := Dy shl 1;
    xd := X1; yd := Y1; e := Dy2 - Dx; term := X2;
    CheckAux := True;

    // clipping rect horizontal entry
    if Y1 < Cy1 then
    begin
      OC := Int64(Dx2) * (Cy1 - Y1) - Dx;
      Inc(xd, OC div Dy2);
      rem := OC mod Dy2;

      if xd > Cx2 then
        Exit;

      if xd >= Cx1 then
      begin
        yd := Cy1;
        Dec(e, rem + Dx);
        if rem > 0 then
        begin
          Inc(xd);
          Inc(e, Dy2);
        end;
        CheckAux := False; // to avoid ugly goto we set this to omit the next check
      end;
    end;

    // clipping rect vertical entry
    if CheckAux and (X1 < Cx1) then
    begin
      OC := Int64(Dy2) * (Cx1 - X1);
      Inc(yd, OC div Dx2);
      rem := OC mod Dx2;

      if (yd > Cy2) or (yd = Cy2) and (rem >= Dx) then
        Exit;

      xd := Cx1;
      Inc(e, rem);
      if (rem >= Dx) then
      begin
        Inc(yd);
        Dec(e, Dx2);
      end;
    end;

    // set auxiliary var to indicate that term is not clipped, since
    // term still has the unclipped value assigned at setup.
    CheckAux := False;

    // is the segment exiting the clipping rect?
    if Y2 > Cy2 then
    begin
      OC := Int64(Dx2) * (Cy2 - Y1) + Dx;
      term := X1 + OC div Dy2;
      rem := OC mod Dy2;
      if rem = 0 then
        Dec(term);
      CheckAux := True; // set auxiliary var to indicate that term is clipped
    end;

    if term > Cx2 then
    begin
      term := Cx2;
      CheckAux := True; // set auxiliary var to indicate that term is clipped
    end;

    Inc(term);

    if Sy = -1 then
      yd := -yd;

    if Sx = -1 then
    begin
      xd := -xd;
      term := -term;
    end;

    Dec(Dx2, Dy2);

    if Swapped then
    begin
      PI := Sx * Width;
      P := @Bits[yd + xd * Width];
    end else
    begin
      PI := Sx;
      Sy := Sy * Width;
      P := @Bits[xd + yd * Width];
    end;

    // do we need to skip the last pixel of the line and is term not clipped?
    if not(L or CheckAux) then
    begin
      if xd < term then
        Dec(term)
      else
        Inc(term);
    end;

    BlendMem := BLEND_MEM[FCombineMode]^;
    while xd <> term do
    begin
      Inc(xd, Sx);

      BlendMem(Value, P^);
      Inc(P, PI);
      if e >= 0 then
      begin
        Inc(P, Sy);
        Dec(e, Dx2);
      end
      else
        Inc(e, Dy2);
    end;
  end;

  Changed(ChangedRect, AREAINFO_LINE + 1);
end;

procedure TCustomBitmap32.LineX(X1, Y1, X2, Y2: TFixed; Value: TColor32; L: Boolean);
var
  n, i: Integer;
  nx, ny, hyp, hypl: Integer;
  A: TColor32;
  h: Single;
  ChangedRect: TRect;
begin
  ChangedRect := MakeRect(FixedRect(X1, Y1, X2, Y2), rrOutside);

  if not FMeasuringMode then
  begin
    nx := X2 - X1; ny := Y2 - Y1;
    Inc(X1, 127); Inc(Y1, 127); Inc(X2, 127); Inc(Y2, 127);

    hyp := Hypot(nx, ny);
    if hyp = 0 then
      Exit;

    hypl := hyp + (Integer(L) * FixedOne);
    if (hypl < 256) then
      Exit;

    n := hypl shr 16;
    if n > 0 then
    begin
      h := 65536 / hyp;
      nx := Round(nx * h); ny := Round(ny * h);
      for i := 0 to n - 1 do
      begin
        SET_T256(X1 shr 8, Y1 shr 8, Value);
        Inc(X1, nx);
        Inc(Y1, ny);
      end;
    end;
    A := Value shr 24;
    hyp := hypl - n shl 16;
    A := A * Cardinal(hyp) shl 8 and $FF000000;
    SET_T256((X1 + X2 - nx) shr 9, (Y1 + Y2 - ny) shr 9, Value and $00FFFFFF + A);
  end;

  Changed(ChangedRect, AREAINFO_LINE + 2); // +1 for AA
end;

procedure TCustomBitmap32.LineF(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean);
begin
  LineX(Fixed(X1), Fixed(Y1), Fixed(X2), Fixed(Y2), Value, L);
end;

// Note:
// ClipLine has been copied from GR32_VectorUtils to avoid referencing that unit here
// since that would prevent inlining in GR32_VectorUtils due to
// H2456 Inline function '%s' has not been expanded because contained unit '%s' uses compiling unit '%s'
function ClipLine(var X1, Y1, X2, Y2: Integer; MinX, MinY, MaxX, MaxY: Integer): Boolean;
var
  C1, C2: Integer;
  V: Integer;
begin
  { Get edge codes }
  C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
  C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;

  if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  begin
    if (C1 and 12) <> 0 then
    begin
      if C1 < 8 then V := MinY else V := MaxY;
      Inc(X1, MulDiv(V - Y1, X2 - X1, Y2 - Y1));
      Y1 := V;
      C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
    end;

    if (C2 and 12) <> 0 then
    begin
      if C2 < 8 then V := MinY else V := MaxY;
      Inc(X2, MulDiv(V - Y2, X2 - X1, Y2 - Y1));
      Y2 := V;
      C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
    end;

    if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
    begin
      if C1 <> 0 then
      begin
        if C1 = 1 then V := MinX else V := MaxX;
        Inc(Y1, MulDiv(V - X1, Y2 - Y1, X2 - X1));
        X1 := V;
        C1 := 0;
      end;

      if C2 <> 0 then
      begin
        if C2 = 1 then V := MinX else V := MaxX;
        Inc(Y2, MulDiv(V - X2, Y2 - Y1, X2 - X1));
        X2 := V;
        C2 := 0;
      end;
    end;
  end;

  Result := (C1 or C2) = 0;
end;

procedure TCustomBitmap32.LineXS(X1, Y1, X2, Y2: TFixed; Value: TColor32; L: Boolean);
var
  n, i: Integer;
  ex, ey, nx, ny, hyp, hypl: Integer;
  A: TColor32;
  h: Single;
  ChangedRect: TRect;
begin
  ChangedRect := MakeRect(FixedRect(X1, Y1, X2, Y2), rrOutside);

  ex := X2; ey := Y2;

  // Check for visibility and clip the coordinates
  if not ClipLine(Integer(X1), Integer(Y1), Integer(X2), Integer(Y2),
    FFixedClipRect.Left - $10000,
    FFixedClipRect.Top - $10000,
    FFixedClipRect.Right, FFixedClipRect.Bottom) then
    Exit;

  if not FMeasuringMode then
  begin
    { TODO : Handle L on clipping here... }

    if (ex <> X2) or (ey <> Y2) then
      L := True;

    // Check if it lies entirely in the bitmap area. Even after clipping
    // some pixels may lie outside the bitmap due to antialiasing
    if (X1 > FFixedClipRect.Left) and (X1 < FFixedClipRect.Right - $20000) and
       (Y1 > FFixedClipRect.Top) and (Y1 < FFixedClipRect.Bottom - $20000) and
       (X2 > FFixedClipRect.Left) and (X2 < FFixedClipRect.Right - $20000) and
       (Y2 > FFixedClipRect.Top) and (Y2 < FFixedClipRect.Bottom - $20000) then
    begin
      LineX(X1, Y1, X2, Y2, Value, L);
      Exit;
    end;

    // if we are still here, it means that the line touches one or several bitmap
    // boundaries. Use the safe version of antialiased pixel routine
    nx := X2 - X1; ny := Y2 - Y1;
    Inc(X1, 127); Inc(Y1, 127); Inc(X2, 127); Inc(Y2, 127);

    hyp := Hypot(nx, ny);
    if hyp = 0 then
      Exit;

    hypl := hyp + (Integer(L) * FixedOne);
    if hypl < 256 then
      Exit;

    n := hypl shr 16;
    if n > 0 then
    begin
      h := 65536 / hyp;
      nx := Round(nx * h); ny := Round(ny * h);
      for i := 0 to n - 1 do
      begin
        SET_TS256(SAR_8(X1), SAR_8(Y1), Value);
        X1 := X1 + nx;
        Y1 := Y1 + ny;
      end;
    end;
    A := Value shr 24;
    hyp := hypl - n shl 16;
    A := A * Cardinal(hyp) shl 8 and $FF000000;
    SET_TS256(SAR_9(X1 + X2 - nx), SAR_9(Y1 + Y2 - ny), Value and $00FFFFFF + A);
  end;

  Changed(ChangedRect, AREAINFO_LINE + 2); // +1 for AA
end;

procedure TCustomBitmap32.LineFS(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean);
begin
  LineXS(Fixed(X1), Fixed(Y1), Fixed(X2), Fixed(Y2), Value, L);
end;

procedure TCustomBitmap32.LineXP(X1, Y1, X2, Y2: TFixed; L: Boolean);
var
  n, i: Integer;
  nx, ny, hyp, hypl: Integer;
  A, C: TColor32;
  ChangedRect: TRect;
begin
  ChangedRect := MakeRect(FixedRect(X1, Y1, X2, Y2), rrOutside);

  if not FMeasuringMode then
  begin
    nx := X2 - X1; ny := Y2 - Y1;
    Inc(X1, 127); Inc(Y1, 127); Inc(X2, 127); Inc(Y2, 127);

    hyp := Hypot(nx, ny);
    if hyp = 0 then
      Exit;

    hypl := hyp + (Integer(L) * FixedOne);
    if hypl < 256 then
      Exit;

    n := hypl shr 16;
    if n > 0 then
    begin
      nx := Round(nx / hyp * 65536);
      ny := Round(ny / hyp * 65536);
      for i := 0 to n - 1 do
      begin
        C := GetStippleColor;
        SET_T256(X1 shr 8, Y1 shr 8, C);
        X1 := X1 + nx;
        Y1 := Y1 + ny;
      end;
    end;

    C := GetStippleColor;
    A := C shr 24;
    hyp := hypl - n shl 16;
    A := A * Longword(hyp) shl 8 and $FF000000;
    SET_T256((X1 + X2 - nx) shr 9, (Y1 + Y2 - ny) shr 9, C and $00FFFFFF + A);
  end;

  Changed(ChangedRect, AREAINFO_LINE + 2); // +1 for AA
end;

procedure TCustomBitmap32.LineFP(X1, Y1, X2, Y2: Single; L: Boolean);
begin
  LineXP(Fixed(X1), Fixed(Y1), Fixed(X2), Fixed(Y2), L);
end;

procedure TCustomBitmap32.LineXSP(X1, Y1, X2, Y2: TFixed; L: Boolean);
const
  StippleInc: array [Boolean] of Integer = (0, 1);
var
  n, i: Integer;
  sx, sy, ex, ey, nx, ny, hyp, hypl: Integer;
  A, C: TColor32;
  ChangedRect: TRect;
begin
  ChangedRect := MakeRect(FixedRect(X1, Y1, X2, Y2), rrOutside);

  if not FMeasuringMode then
  begin
    sx := X1; sy := Y1; ex := X2; ey := Y2;

    // Check for visibility and clip the coordinates
    if not ClipLine(Integer(X1), Integer(Y1), Integer(X2), Integer(Y2),
      FFixedClipRect.Left - $10000, FFixedClipRect.Top - $10000,
      FFixedClipRect.Right, FFixedClipRect.Bottom) then
    begin
      AdvanceStippleCounter(GR32_Math.Hypot(Integer((X2 - X1) shr 16), Integer((Y2 - Y1) shr 16) - StippleInc[L]));
      Exit;
    end;

    if (ex <> X2) or (ey <> Y2) then
      L := True;

    // Check if it lies entirely in the bitmap area. Even after clipping
    // some pixels may lie outside the bitmap due to antialiasing
    if (X1 > FFixedClipRect.Left) and (X1 < FFixedClipRect.Right - $20000) and
       (Y1 > FFixedClipRect.Top) and (Y1 < FFixedClipRect.Bottom - $20000) and
       (X2 > FFixedClipRect.Left) and (X2 < FFixedClipRect.Right - $20000) and
       (Y2 > FFixedClipRect.Top) and (Y2 < FFixedClipRect.Bottom - $20000) then
    begin
      LineXP(X1, Y1, X2, Y2, L);
      Exit;
    end;

    if (sx <> X1) or (sy <> Y1) then
      AdvanceStippleCounter(GR32_Math.Hypot(Integer((X1 - sx) shr 16), Integer((Y1 - sy) shr 16)));

    // if we are still here, it means that the line touches one or several bitmap
    // boundaries. Use the safe version of antialiased pixel routine
    nx := X2 - X1; ny := Y2 - Y1;
    Inc(X1, 127); Inc(Y1, 127); Inc(X2, 127); Inc(Y2, 127);

    hyp := GR32_Math.Hypot(nx, ny);
    if hyp = 0 then
      Exit;

    hypl := hyp + (Integer(L) * FixedOne);
    if hypl < 256 then
      Exit;

    n := hypl shr 16;
    if n > 0 then
    begin
      nx := Round(nx / hyp * 65536); ny := Round(ny / hyp * 65536);
      for i := 0 to n - 1 do
      begin
        C := GetStippleColor;
        SET_TS256(SAR_8(X1), SAR_8(Y1), C);
        X1 := X1 + nx;
        Y1 := Y1 + ny;
      end;
    end;

    C := GetStippleColor;
    A := C shr 24;
    hyp := hypl - n shl 16;
    A := A * Longword(hyp) shl 8 and $FF000000;
    SET_TS256(SAR_9(X1 + X2 - nx), SAR_9(Y1 + Y2 - ny), C and $00FFFFFF + A);

    if (ex <> X2) or (ey <> Y2) then
      AdvanceStippleCounter(GR32_Math.Hypot(Integer((X2 - ex) shr 16), Integer((Y2 - ey) shr 16) - StippleInc[L]));
  end;

  Changed(ChangedRect, AREAINFO_LINE + 2); // +1 for AA
end;

procedure TCustomBitmap32.LineFSP(X1, Y1, X2, Y2: Single; L: Boolean);
begin
  LineXSP(Fixed(X1), Fixed(Y1), Fixed(X2), Fixed(Y2), L);
end;

procedure TCustomBitmap32.LineA(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean);
var
  Dx, Dy, Sx, Sy, D: Integer;
  EC, EA: Word;
  CI: Byte;
  P: PColor32;
  BlendMemEx: TBlendMemEx;
begin
  if (X1 = X2) or (Y1 = Y2) then
  begin
    LineT(X1, Y1, X2, Y2, Value, L);
    Exit;
  end;

  if not FMeasuringMode then
  begin
    Dx := X2 - X1;
    Dy := Y2 - Y1;

    if Dx > 0 then
      Sx := 1
    else
    begin
      Sx := -1;
      Dx := -Dx;
    end;

    if Dy > 0 then
      Sy := 1
    else
    begin
      Sy := -1;
      Dy := -Dy;
    end;

    EC := 0;
    BLEND_MEM[FCombineMode]^(Value, Bits[X1 + Y1 * Width]);
    BlendMemEx := BLEND_MEM_EX[FCombineMode]^;

    if Dy > Dx then
    begin
      EA := Dx shl 16 div Dy;

      if not L then
        Dec(Dy);

      while Dy > 0 do
      begin
        Dec(Dy);
        D := EC;
        Inc(EC, EA);

        if EC <= D then
          Inc(X1, Sx);

        Inc(Y1, Sy);
        CI := EC shr 8;
        P := @Bits[X1 + Y1 * Width];
        BlendMemEx(Value, P^, CI xor $FF);

        Inc(P, Sx);
        BlendMemEx(Value, P^, CI);
      end;
    end else // DY <= DX
    begin
      EA := Dy shl 16 div Dx;
      if not L then
        Dec(Dx);

      while Dx > 0 do
      begin
        Dec(Dx);
        D := EC;

        Inc(EC, EA);
        if EC <= D then
          Inc(Y1, Sy);

        Inc(X1, Sx);
        CI := EC shr 8;
        P := @Bits[X1 + Y1 * Width];
        BlendMemEx(Value, P^, CI xor $FF);

        if Sy = 1 then
          Inc(P, Width) else Dec(P, Width);
        BlendMemEx(Value, P^, CI);
      end;
    end;
  end;

  Changed(MakeRect(X1, Y1, X2, Y2), AREAINFO_LINE + 2); // +1 for AA
end;

procedure TCustomBitmap32.LineAS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean);
var
  Cx1, Cx2, Cy1, Cy2, PI, Sx, Sy, Dx, Dy, xd, yd, rem, term, tmp: Integer;
  CheckVert, CornerAA, TermClipped: Boolean;
  D1, D2: PInteger;
  EC, EA, ED, D: Word;
  CI: Byte;
  P: PColor32;
  BlendMemEx: TBlendMemEx;
  ChangedRect: TRect;
begin
  if (FClipRect.Right = FClipRect.Left) or (FClipRect.Bottom = FClipRect.Top) then
    Exit;

  ChangedRect := MakeRect(X1, Y1, X2, Y2);

  if not FMeasuringMode then
  begin

    Dx := X2 - X1; Dy := Y2 - Y1;

    // check for trivial cases...
    if Abs(Dx) = Abs(Dy) then // diagonal line?
    begin
      LineTS(X1, Y1, X2, Y2, Value, L);

      Exit;
    end else
    if Dx = 0 then // vertical line?
    begin
      if Dy > 0 then
        VertLineTS(X1, Y1, Y2 - 1, Value)
      else
      if Dy < 0 then
        VertLineTS(X1, Y2 + 1, Y1, Value);

      if L then
      begin
        SetPixelTS(X2, Y2, Value);
        Changed(MakeRect(X2, Y2, X2+1, Y2+1));
      end;

      Exit;
    end else
    if Dy = 0 then // horizontal line?
    begin
      if Dx > 0 then
        HorzLineTS(X1, Y1, X2 - 1, Value)
      else
      if Dx < 0 then
        HorzLineTS(X2 + 1, Y1, X1, Value);

      if L then
      begin
        SetPixelTS(X2, Y2, Value);
        Changed(MakeRect(X2, Y2, X2+1, Y2+1));
      end;

      Exit;
    end;

    Cx1 := FClipRect.Left; Cx2 := FClipRect.Right - 1;
    Cy1 := FClipRect.Top;  Cy2 := FClipRect.Bottom - 1;

    if Dx > 0 then
    begin
      if (X1 > Cx2) or (X2 < Cx1) then
        Exit; // segment not visible

      Sx := 1;
    end else
    begin
      if (X2 > Cx2) or (X1 < Cx1) then
        Exit; // segment not visible

      Sx := -1;
      X1 := -X1;   X2 := -X2;   Dx := -Dx;
      Cx1 := -Cx1; Cx2 := -Cx2;
      Swap(Cx1, Cx2);
    end;

    if Dy > 0 then
    begin
      if (Y1 > Cy2) or (Y2 < Cy1) then
        Exit; // segment not visible

      Sy := 1;
    end else
    begin
      if (Y2 > Cy2) or (Y1 < Cy1) then
        Exit; // segment not visible

      Sy := -1;
      Y1 := -Y1;   Y2 := -Y2;   Dy := -Dy;
      Cy1 := -Cy1; Cy2 := -Cy2;
      Swap(Cy1, Cy2);
    end;

    if Dx < Dy then
    begin
      Swap(X1, Y1); Swap(X2, Y2); Swap(Dx, Dy);
      Swap(Cx1, Cy1); Swap(Cx2, Cy2); Swap(Sx, Sy);
      D1 := @yd; D2 := @xd;
      PI := Sy;
    end else
    begin
      D1 := @xd; D2 := @yd;
      PI := Sy * Width;
    end;

    rem := 0;
    EA := Dy shl 16 div Dx;
    EC := 0;
    xd := X1; yd := Y1;
    CheckVert := True;
    CornerAA := False;
    BlendMemEx := BLEND_MEM_EX[FCombineMode]^;

    // clipping rect horizontal entry
    if Y1 < Cy1 then
    begin
      tmp := (Cy1 - Y1) * 65536;
      rem := tmp - 65536; // rem := (Cy1 - Y1 - 1) * 65536;
      if tmp mod EA > 0 then
        tmp := tmp div EA + 1
      else
        tmp := tmp div EA;

      xd := Math.Min(xd + tmp, X2 + 1);
      EC := tmp * EA;

      if rem mod EA > 0 then
        rem := rem div EA + 1
      else
        rem := rem div EA;

      tmp := tmp - rem;

      // check whether the line is partly visible
      if xd > Cx2 then
      begin
        // do we need to draw an antialiased part on the corner of the clip rect?
        if xd <= Cx2 + tmp then
          CornerAA := True
        else
          Exit;
      end;

      if (xd {+ 1} >= Cx1) or CornerAA then
      begin
        yd := Cy1;
        rem := xd; // save old xd

        ED := EC - EA;
        term := SwapConstrain(xd - tmp, Cx1, Cx2);

        if CornerAA then
        begin
          Dec(ED, (xd - Cx2 - 1) * EA);
          xd := Cx2 + 1;
        end;

        // do we need to negate the vars?
        if Sy = -1 then
          yd := -yd;

        if Sx = -1 then
        begin
          xd := -xd;
          term := -term;
        end;

        // draw special case horizontal line entry (draw only last half of entering segment)
        while xd <> term do
        begin
          Inc(xd, -Sx);
          BlendMemEx(Value, Bits[D1^ + D2^ * Width], ED shr 8);
          Dec(ED, EA);
        end;

        if CornerAA then
        begin
          // we only needed to draw the visible antialiased part of the line,
          // everything else is outside of our cliprect, so exit now since
          // there is nothing more to paint...
          Changed(MakeRect(X1, Y1, X2, Y2), AREAINFO_LINE + 2);
          Exit;
        end;

        if Sy = -1 then
          yd := -yd;  // negate back
        xd := rem;  // restore old xd
        CheckVert := False; // to avoid ugly goto we set this to omit the next check
      end;
    end;

    // clipping rect vertical entry
    if CheckVert and (X1 < Cx1) then
    begin
      tmp := (Cx1 - X1) * EA;
      Inc(yd, tmp div 65536);
      EC := tmp;
      xd := Cx1;
      if (yd > Cy2) then
        Exit // Nothing modified so far - no need to call Changed
      else
      if (yd = Cy2) then
        CornerAA := True;
    end;

    term := X2;
    TermClipped := False;
    CheckVert := False;

    // horizontal exit?
    if Y2 > Cy2 then
    begin
      tmp := (Cy2 - Y1) * 65536;
      term := X1 + tmp div EA;
      if not(tmp mod EA > 0) then
        Dec(Term);

      if term < Cx2 then
      begin
        rem := tmp + 65536; // was: rem := (Cy2 - Y1 + 1) * 65536;
        if rem mod EA > 0 then
          rem := X1 + rem div EA + 1
        else
          rem := X1 + rem div EA;

        if rem > Cx2 then
          rem := Cx2;
        CheckVert := True;
      end;

      TermClipped := True;
    end;

    if term > Cx2 then
    begin
      term := Cx2;
      TermClipped := True;
    end;

    Inc(term);

    if Sy = -1 then
      yd := -yd;

    if Sx = -1 then
    begin
      xd := -xd;
      term := -term;
      rem := -rem;
    end;

    // draw line
    if not CornerAA then
    begin
      // do we need to skip the last pixel of the line and is term not clipped?
      if not(L or TermClipped) and not CheckVert then
      begin
        if xd < term then
          Dec(term)
        else
        if xd > term then
          Inc(term);
      end;

      while xd <> term do
      begin
        CI := EC shr 8;
        P := @Bits[D1^ + D2^ * Width];
        BlendMemEx(Value, P^, CI xor $FF);

        Inc(P, PI);
        BlendMemEx(Value, P^, CI);

        // check for overflow and jump to next line...
        D := EC;
        Inc(EC, EA);
        if EC <= D then
          Inc(yd, Sy);

        Inc(xd, Sx);
      end;
    end;

    // draw special case horizontal line exit (draw only first half of exiting segment)
    if CheckVert then
      while xd <> rem do
      begin
        BlendMemEx(Value, Bits[D1^ + D2^ * Width], EC shr 8 xor $FF);
        Inc(EC, EA);
        Inc(xd, Sx);
      end;
  end;

  Changed(ChangedRect, AREAINFO_LINE + 2); // +1 for AA
end;

procedure TCustomBitmap32.MoveTo(X, Y: Integer);
begin
  RasterX := X;
  RasterY := Y;
end;

procedure TCustomBitmap32.LineToS(X, Y: Integer);
begin
  LineS(RasterX, RasterY, X, Y, PenColor);
  RasterX := X;
  RasterY := Y;
end;

procedure TCustomBitmap32.LineToTS(X, Y: Integer);
begin
  LineTS(RasterX, RasterY, X, Y, PenColor);
  RasterX := X;
  RasterY := Y;
end;

procedure TCustomBitmap32.LineToAS(X, Y: Integer);
begin
  LineAS(RasterX, RasterY, X, Y, PenColor);
  RasterX := X;
  RasterY := Y;
end;

procedure TCustomBitmap32.MoveToX(X, Y: TFixed);
begin
  RasterXF := X;
  RasterYF := Y;
end;

procedure TCustomBitmap32.MoveToF(X, Y: Single);
begin
  RasterXF := Fixed(X);
  RasterYF := Fixed(Y);
end;

procedure TCustomBitmap32.LineToXS(X, Y: TFixed);
begin
  LineXS(RasterXF, RasterYF, X, Y, PenColor);
  RasterXF := X;
  RasterYF := Y;
end;

procedure TCustomBitmap32.LineToFS(X, Y: Single);
begin
  LineToXS(Fixed(X), Fixed(Y));
end;

procedure TCustomBitmap32.LineToXSP(X, Y: TFixed);
begin
  LineXSP(RasterXF, RasterYF, X, Y);
  RasterXF := X;
  RasterYF := Y;
end;

procedure TCustomBitmap32.LineToFSP(X, Y: Single);
begin
  LineToXSP(Fixed(X), Fixed(Y));
end;

procedure TCustomBitmap32.FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32);
var
  j: Integer;
  P: PColor32Array;
begin
  if not FMeasuringMode then
  begin
    if (FBits <> nil) then
      for j := Y1 to Y2 - 1 do
      begin
        P := Pointer(@Bits[j * FWidth]);
        FillLongword(P[X1], X2 - X1, Value);
      end;
  end;

  Changed(MakeRect(X1, Y1, X2+1, Y2+1));
end;

procedure TCustomBitmap32.FillRectS(X1, Y1, X2, Y2: Integer; Value: TColor32);
begin
  if (X2 > X1) and (Y2 > Y1) and
    (X1 < FClipRect.Right) and (Y1 < FClipRect.Bottom) and
    (X2 > FClipRect.Left) and (Y2 > FClipRect.Top) then
  begin
    if X1 < FClipRect.Left then
      X1 := FClipRect.Left;
    if Y1 < FClipRect.Top then
      Y1 := FClipRect.Top;
    if X2 > FClipRect.Right then
      X2 := FClipRect.Right;
    if Y2 > FClipRect.Bottom then
      Y2 := FClipRect.Bottom;

    FillRect(X1, Y1, X2, Y2, Value); // Calls Changed()
  end;
end;

procedure TCustomBitmap32.FillRectT(X1, Y1, X2, Y2: Integer; Value: TColor32);
var
  i, j: Integer;
  P: PColor32;
  A: Integer;
  ChangedRect: TRect;
begin
  A := Value shr 24;

  if A = $FF then
    FillRect(X1, Y1, X2, Y2, Value) // calls Changed...
  else
  if A <> 0 then
  begin
    ChangedRect := MakeRect(X1, Y1, X2 + 1, Y2 + 1);

    if not FMeasuringMode then
    begin
      Dec(Y2);
      Dec(X2);
      for j := Y1 to Y2 do
      begin
        P := GetPixelPtr(X1, j);
        if CombineMode = cmBlend then
        begin
          for i := X1 to X2 do
          begin
            CombineMem(Value, P^, A);
            Inc(P);
          end;
        end else
        begin
          for i := X1 to X2 do
          begin
            MergeMem(Value, P^);
            Inc(P);
          end;
        end;
      end;
    end;

    Changed(ChangedRect);
  end;
end;

procedure TCustomBitmap32.FillRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32);
begin
  if (X2 > X1) and (Y2 > Y1) and
    (X1 < FClipRect.Right) and (Y1 < FClipRect.Bottom) and
    (X2 > FClipRect.Left) and (Y2 > FClipRect.Top) then
  begin
    if X1 < FClipRect.Left then
      X1 := FClipRect.Left;
    if Y1 < FClipRect.Top then
      Y1 := FClipRect.Top;
    if X2 > FClipRect.Right then
      X2 := FClipRect.Right;
    if Y2 > FClipRect.Bottom then
      Y2 := FClipRect.Bottom;

    FillRectT(X1, Y1, X2, Y2, Value); // Calls Changed()
  end;
end;

procedure TCustomBitmap32.FillRectS(const ARect: TRect; Value: TColor32);
begin
  FillRectS(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Value);
end;

procedure TCustomBitmap32.FillRectTS(const ARect: TRect; Value: TColor32);
begin
  FillRectTS(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Value);
end;

procedure TCustomBitmap32.FrameRectS(X1, Y1, X2, Y2: Integer; Value: TColor32);
begin
  // measuring is handled in inner drawing operations...
  if (X2 > X1) and (Y2 > Y1) and
    (X1 < FClipRect.Right) and (Y1 < FClipRect.Bottom) and
    (X2 > FClipRect.Left) and (Y2 > FClipRect.Top) then
  begin
    Dec(Y2);
    Dec(X2);
    HorzLineS(X1, Y1, X2, Value);

    if Y2 > Y1 then
      HorzLineS(X1, Y2, X2, Value);

    if Y2 > Y1 + 1 then
    begin
      VertLineS(X1, Y1 + 1, Y2 - 1, Value);

      if X2 > X1 then
        VertLineS(X2, Y1 + 1, Y2 - 1, Value);
    end;
  end;
end;

procedure TCustomBitmap32.FrameRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32);
begin
  // measuring is handled in inner drawing operations...
  if (X2 > X1) and (Y2 > Y1) and
    (X1 < FClipRect.Right) and (Y1 < FClipRect.Bottom) and
    (X2 > FClipRect.Left) and (Y2 > FClipRect.Top) then
  begin
    Dec(Y2);
    Dec(X2);
    HorzLineTS(X1, Y1, X2, Value);

    if Y2 > Y1 then
      HorzLineTS(X1, Y2, X2, Value);

    if Y2 > Y1 + 1 then
    begin
      VertLineTS(X1, Y1 + 1, Y2 - 1, Value);

      if X2 > X1 then
        VertLineTS(X2, Y1 + 1, Y2 - 1, Value);
    end;
  end;
end;

procedure TCustomBitmap32.FrameRectTSP(X1, Y1, X2, Y2: Integer);
begin
  // measuring is handled in inner drawing operations...
  if (X2 > X1) and (Y2 > Y1) and
    (X1 < Width) and (Y1 < Height) and  // don't check against ClipRect here
    (X2 > 0) and (Y2 > 0) then          // due to StippleCounter
  begin
    Dec(X2);
    Dec(Y2);
    if X1 = X2 then
    begin
      if Y1 = Y2 then
      begin
        SetPixelT(X1, Y1, GetStippleColor);
        Changed(MakeRect(X1, Y1, X1 + 1, Y1 + 1));
      end else
        VertLineTSP(X1, Y1, Y2)
    end else
    begin
      if Y1 = Y2 then
        HorzLineTSP(X1, Y1, X2)
      else
      begin
        HorzLineTSP(X1, Y1, X2 - 1);
        VertLineTSP(X2, Y1, Y2 - 1);
        HorzLineTSP(X2, Y2, X1 + 1);
        VertLineTSP(X1, Y2, Y1 + 1);
      end;
    end;
  end;
end;

procedure TCustomBitmap32.FrameRectS(const ARect: TRect; Value: TColor32);
begin
  FrameRectS(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Value);
end;

procedure TCustomBitmap32.FrameRectTS(const ARect: TRect; Value: TColor32);
begin
  FrameRectTS(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Value);
end;

procedure TCustomBitmap32.RaiseRectTS(X1, Y1, X2, Y2: Integer; Contrast: Integer);
var
  C1, C2: TColor32;
begin
  // measuring is handled in inner drawing operations...
  if (X2 > X1) and (Y2 > Y1) and
     (X1 < FClipRect.Right) and (Y1 < FClipRect.Bottom) and
     (X2 > FClipRect.Left) and (Y2 > FClipRect.Top) then
  begin
    if (Contrast > 0) then
    begin
      C1 := SetAlpha(clWhite32, Clamp(Contrast * 512 div 100));
      C2 := SetAlpha(clBlack32, Clamp(Contrast * $FF div 100));
    end else
    if Contrast < 0 then
    begin
      Contrast := -Contrast;
      C1 := SetAlpha(clBlack32, Clamp(Contrast * $FF div 100));
      C2 := SetAlpha(clWhite32, Clamp(Contrast * 512 div 100));
    end else
      Exit;

    Dec(X2);
    Dec(Y2);
    HorzLineTS(X1, Y1, X2, C1);
    HorzLineTS(X1, Y2, X2, C2);

    Inc(Y1);
    Dec(Y2);
    VertLineTS(X1, Y1, Y2, C1);
    VertLineTS(X2, Y1, Y2, C2);
  end;
end;

procedure TCustomBitmap32.RaiseRectTS(const ARect: TRect; Contrast: Integer);
begin
  RaiseRectTS(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Contrast);
end;

function TCustomBitmap32.LoadFromBMPStream(Stream: TStream; Size: Int64): boolean;
var
  BitmapFileHeader: TBitmapFileHeader;
begin
  Result := False;

  if (Stream.Read(BitmapFileHeader, SizeOf(TBitmapFileHeader)) < SizeOf(TBitmapFileHeader)) then
    exit;

  // Verify file signature
  if (BitmapFileHeader.bfType <> $4D42) then // BM file signature
    exit;

  if (BitmapFileHeader.bfSize <> Size) then
    BitmapFileHeader.bfSize := Size;

  Result := LoadFromDIBStream(Stream, BitmapFileHeader.bfSize - SizeOf(TBitmapFileHeader));
end;


function TCustomBitmap32.LoadFromDIBStream(Stream: TStream; Size: Int64): boolean;

  function GetShift(Mask, TargetMask: DWORD): integer;
  begin
    Result := 0;
    if (Mask = 0) then
      exit;

    // Shift the mask all the way to the right, so the mask starts at bit 0
    while (Mask and 1 = 0) do
    begin
      Mask := Mask shr 1;
      Dec(Result);
    end;

    // Shift the target mask all the way to the right, so the mask starts at bit 0
    while (TargetMask and 1 = 0) do
    begin
      TargetMask := TargetMask shr 1;
      Inc(Result);
    end;

    // The result is the number of bits the mask must be shifted in order to align
    // with the target mask.
    // Positive value means shift left, negative means shift right.
  end;

  procedure EnsureAlpha;
  var
    Alpha: PByte;
    i: integer;
  begin
    // Since the alpha channel of this format isn't defined we can either assume
    // that all pixels have Alpha=255 or we can assume that the alpha is
    // specified in the source pixel data.
    // Instead of just chosing one of these and hoping for the best we make a
    // choice based on the actual alpha values: If the bitmap contains alpha
    // values then we leave it as is. If it doesn't contain alpha values then
    // we reset the alpha of the whole bitmap to 255.
    Alpha := @(PColor32Entry(Bits).A);

    for i := 0 to Width * Height - 1 do
    begin
      if (Alpha^ <> 0) then
        exit;

      Inc(Alpha, SizeOf(DWORD));
    end;

    ResetAlpha;
  end;

type
  TChannelMask = record
    Shift: integer;
    Mask: DWORD;
    Enabled: boolean;
  end;

var
  BitmapHeader: TBitmapHeader;
  ChunkSize: integer;
  InfoHeaderVersion: TInfoHeaderVersion;
  i, j: integer;
  Row: integer;
  DeltaRow: integer;
  Pixels: PDWord;
  ChannelMasks: array[TColor32Component] of TChannelMask;
  Channel: TColor32Component;
  Value, NewValue: DWORD;
  Padding: integer;
  DataSize: integer;
  ScanlineRow: PColor32Array;
const
{$IFNDEF RGBA_FORMAT}
  Masks: array[TColor32Component] of DWORD = ($000000FF, $0000FF00, $00FF0000, $FF000000); // BGRA
  ChannelToIndex: array[TColor32Component] of integer = (2, 1, 0, 3); // Maps TColor32Component to RGBA index
{$ELSE}
  Masks: array[TColor32Component] of DWORD = ($00FF0000, $0000FF00, $000000FF, $FF000000); // RGBA
  ChannelToIndex: array[TColor32Component] of integer = (0, 1, 2, 3); // Maps TColor32Component to RGBA index
{$ENDIF}
begin
  Result := False;

  FillChar(BitmapHeader, SizeOf(TBitmapHeader), 0);

  // Read the info header size field
  Dec(Size, SizeOf(BitmapHeader.InfoHeader.biSize));
  if (Size < 0) then
    exit;
  if (Stream.Read(BitmapHeader.InfoHeader.biSize, SizeOf(BitmapHeader.InfoHeader.biSize)) <> SizeOf(BitmapHeader.InfoHeader.biSize)) then
    exit;

  // Validate info header size and determine header version
  case BitmapHeader.InfoHeader.biSize of
    SizeOf(TBitmapCoreHeader): exit;
    // Size of TBitmapCoreHeader2 vary from 16 to 64 but we assume it's 64
    SizeOf(TBitmapCoreHeader2):exit;
    SizeOf(TBitmapInfoHeader): InfoHeaderVersion := InfoHeaderVersion1;
    SizeOf(TBitmapV2Header):   InfoHeaderVersion := InfoHeaderVersion2;
    SizeOf(TBitmapV3Header):   InfoHeaderVersion := InfoHeaderVersion3;
    SizeOf(TBitmapV4Header):   InfoHeaderVersion := InfoHeaderVersion4;
    SizeOf(TBitmapV5Header):   InfoHeaderVersion := InfoHeaderVersion5;
  else
    if (BitmapHeader.InfoHeader.biSize < SizeOf(TBitmapInfoHeader)) then
      exit;

    // Guard against bogus header size. Limit is arbitrary.
    if (BitmapHeader.InfoHeader.biSize >= 4096) then
      exit;

    // Assume header is v1 compatible
    InfoHeaderVersion := InfoHeaderVersion1;
  end;

  // Get the rest of the bitmap info header
  ChunkSize := BitmapHeader.InfoHeader.biSize - SizeOf(BitmapHeader.InfoHeader.biSize);
  Dec(Size, ChunkSize);
  if (Size < 0) then
    exit;
  if (Stream.Read(BitmapHeader.InfoHeader.biWidth, ChunkSize) <> ChunkSize) then
    exit;

  // We only support 24-bit and 32-bit bitmaps
  if not (BitmapHeader.InfoHeader.biBitCount in [24, 32]) then
    exit;

  // Planes must be 1
  if (BitmapHeader.InfoHeader.biPlanes <> 1) then
    BitmapHeader.InfoHeader.biPlanes := 1;

  // Width must be positive
  if (BitmapHeader.InfoHeader.biWidth < 0) then
    BitmapHeader.InfoHeader.biWidth := -BitmapHeader.InfoHeader.biWidth;

  // Pad input rows to 32 bits
  Padding := (SizeOf(DWORD) - (((BitmapHeader.InfoHeader.biBitCount shr 3) * BitmapHeader.InfoHeader.biWidth) and (SizeOf(DWORD)-1))) and (SizeOf(DWORD)-1);
  DataSize := ((BitmapHeader.InfoHeader.biBitCount shr 3) * BitmapHeader.InfoHeader.biWidth + Padding) * Abs(BitmapHeader.InfoHeader.biHeight);
  Dec(Size, DataSize);

  if (BitmapHeader.InfoHeader.biCompression = BI_RGB) then
  begin
    // Skip color table so we're ready to read the pixel data.
    // Note: We ignore the pixel offset stored in the header since this
    // value is often incorrect.
    if (BitmapHeader.InfoHeader.biClrUsed > 0) then
    begin
      Dec(Size, BitmapHeader.InfoHeader.biClrUsed * SizeOf(DWORD));
      if (Size < 0) then
        exit;
      Stream.Seek(BitmapHeader.InfoHeader.biClrUsed * SizeOf(DWORD), soCurrent);
    end;
  end else
  if (BitmapHeader.InfoHeader.biCompression = BI_BITFIELDS) then
  begin
    // BI_BITFIELDS is only valid for 16 and 32 bit count
    if BitmapHeader.InfoHeader.biBitCount = 24 then
      exit;

    // For versions > v1 the header contains a color mask.
    // For BI_BITFIELDS the header is additionally followed by a color table with 3
    // values that can also be interpreted as a color mask.
    // Because the BI_BITFIELDS layout has been so poorly documented different
    // interpretations of it has lead to some implementations including the color
    // table and some excluding it.
    // This is true even within Windows and its utilities. In particular the Windows
    // clipboard's handling of CF_DIBV5 appears to produce both variations depending on
    // various circumstances.
    //
    // Since Windows seems able to work around the two different variations we'll try to
    // do that too; If there's exactly 12 bytes missing when we're about to read the
    // color table, then we simply skip reading it.

    // For version 1 we always need to get the mask from the color table.
    if (InfoHeaderVersion = InfoHeaderVersion1) then
    begin
      // Read the RGB mask into the v2 header RGB mask fields
      ChunkSize := 3 * SizeOf(DWORD);
      Dec(Size, ChunkSize);
      if (Size < 0) then
        exit;

      if (Stream.Read(BitmapHeader.V2Header.bV2RedMask, ChunkSize) <> ChunkSize) then
        exit;
    end else
    begin
      // Read the color table if it's there.

      // Work around BI_BITFIELDS DIBs that lack the color table after the header;
      // If there's exactly 12 bytes missing then we assume that these are the missing
      // color table and ignore it.
      ChunkSize := 3 * SizeOf(DWORD);
      if (Size >= ChunkSize) then
      begin
        Dec(Size, ChunkSize);
        // The color table is there but do we need to actually read it?
        // If the header color masks contains values then we don't need the values in
        // the color table so we just skip past them. Otherwise we read them into the
        // header color mask fields.
        if (BitmapHeader.V2Header.bV2RedMask = 0) and (BitmapHeader.V2Header.bV2GreenMask = 0) and (BitmapHeader.V2Header.bV2BlueMask = 0) then
        begin
          if (Stream.Read(BitmapHeader.V2Header.bV2RedMask, ChunkSize) <> ChunkSize) then
            exit;
        end else
          Stream.Seek(ChunkSize, soFromCurrent);
      end;
    end;

    // Check if RGBA mask is present and values are valid
    // Validate RGB mask; All components must have a value and the values must not overlap.
    if (BitmapHeader.V2Header.bV2RedMask = 0) or (BitmapHeader.V2Header.bV2GreenMask = 0) or (BitmapHeader.V2Header.bV2BlueMask = 0) or
      ((BitmapHeader.V2Header.bV2RedMask and BitmapHeader.V2Header.bV2GreenMask <> 0) or
       (BitmapHeader.V2Header.bV2RedMask and BitmapHeader.V2Header.bV2BlueMask <> 0) or
       (BitmapHeader.V2Header.bV2GreenMask and BitmapHeader.V2Header.bV2BlueMask <> 0)) then
    begin
      // Reset to 888
      BitmapHeader.V2Header.bV2RedMask := Masks[ccRed];
      BitmapHeader.V2Header.bV2GreenMask := Masks[ccGreen];
      BitmapHeader.V2Header.bV2BlueMask := Masks[ccBlue];
    end;

    // Validate A mask. Value is optional but must not overlap RGB mask.
    if (InfoHeaderVersion >= InfoHeaderVersion3) then
    begin
      if (BitmapHeader.V3Header.bV3AlphaMask and (BitmapHeader.V3Header.bV3RedMask or BitmapHeader.V3Header.bV3GreenMask or BitmapHeader.V3Header.bV3BlueMask) <> 0) then
        // Reset alpha
        BitmapHeader.V3Header.bV3AlphaMask := $FFFFFFFF and
          not(BitmapHeader.V3Header.bV3RedMask or BitmapHeader.V3Header.bV3GreenMask or BitmapHeader.V3Header.bV3BlueMask);
    end;

    // If the color mask corresponds to the BI_RGB layout then we change
    // the compression type to BI_RGB so we can read the pixels with
    // the simpler BI_RGB method.
    if (InfoHeaderVersion <= InfoHeaderVersion2) then
    begin
      if (BitmapHeader.V2Header.bV2RedMask = Masks[ccRed]) and
        (BitmapHeader.V2Header.bV2GreenMask = Masks[ccGreen]) and
        (BitmapHeader.V2Header.bV2BlueMask = Masks[ccBlue]) then
        BitmapHeader.InfoHeader.biCompression := BI_RGB;
    end else
    begin
      if (BitmapHeader.V3Header.bV3RedMask = Masks[ccRed]) and
        (BitmapHeader.V3Header.bV3GreenMask = Masks[ccGreen]) and
        (BitmapHeader.V3Header.bV3BlueMask = Masks[ccBlue]) and
        (BitmapHeader.V3Header.bV3AlphaMask = Masks[ccAlpha]) then
        BitmapHeader.InfoHeader.biCompression := BI_RGB;
    end;
  end else
    // We only support BI_RGB and BI_BITFIELDS compression
    exit;

  // Make sure there's enough data left for the pixels
  if (Size < 0) then
    exit;

  // Set bitmap size and allocate pixel data so we can read into it
  SetSize(BitmapHeader.InfoHeader.biWidth, Abs(BitmapHeader.InfoHeader.biHeight));

  // Check whether the bitmap is saved top-down or bottom-up:
  // - Negavive height: top-down
  // - Positive height: bottom-up
  if (BitmapHeader.InfoHeader.biHeight > 0) then
  begin
    // Bitmap is stored bottom-up
    Row := Height-1;
    DeltaRow := -1;
  end else
  begin
    // Bitmap is stored top-down
    Row := 0;
    DeltaRow := 1;
  end;


  if (BitmapHeader.InfoHeader.biCompression = BI_RGB) then
  begin

    case BitmapHeader.InfoHeader.biBitCount of
      24:
        // Read one RGB pixel at a time
        for i := 0 to Height - 1 do
        begin
          ScanlineRow := Scanline[Row];
          for j := 0 to Width - 1 do
          begin
            // Read RGB data and reset alpha
            Stream.ReadBuffer(ScanlineRow[j], 3);
            TColor32Entry(ScanlineRow[j]).A := $FF;
          end;

          if (Padding > 0) then
            Stream.Seek(Padding, soCurrent);

          Inc(Row, DeltaRow);
        end;

      32:
        begin
          Assert(Padding = 0);

          if (BitmapHeader.InfoHeader.biHeight > 0) then
          begin
            // Bitmap is stored bottom-up: Read one row at a time
            ChunkSize := Width * SizeOf(DWORD);
            for i := Height - 1 downto 0 do
              Stream.ReadBuffer(Scanline[i]^, ChunkSize);
          end else
            // Bitmap is stored top-down: Read all rows in one go
            Stream.ReadBuffer(Bits^, Width * Height * SizeOf(DWORD))
        end;
    end;

    if (InfoHeaderVersion < InfoHeaderVersion3) then
      EnsureAlpha;

{$IFDEF RGBA_FORMAT}
    // BMP stores pixels in ABGR order but we need them in ARGB order.
    // Swap R and B channels
    for i := 0 to FHeight * FWidth - 1 do
      SwapRedBlueMem(FBits[i]);
{$ENDIF}

  end else
  begin
    Assert(Padding = 0);

    // Determine how much we need to shift the masked color values in order
    // to get them into the desired position.
    for Channel := Low(TColor32Component) to High(TColor32Component) do
    begin
      ChannelMasks[Channel].Shift := GetShift(BitmapHeader.Header.bmiColors[ChannelToIndex[Channel]], Masks[Channel]);
      ChannelMasks[Channel].Mask := Masks[Channel];
      ChannelMasks[Channel].Enabled := (Channel <> ccAlpha) or (InfoHeaderVersion >= InfoHeaderVersion3);
    end;

    // Read one row at a time into our bitmap and then decode it in place.
    ChunkSize := Width * SizeOf(DWORD);
    for i := 0 to Height-1 do
    begin
      Pixels := PDWord(Scanline[Row]);
      Stream.ReadBuffer(Pixels^, ChunkSize);

      for j := 0 to Width-1 do
      begin
        Value := Pixels^;
        NewValue := 0;

        for Channel := Low(TColor32Component) to High(TColor32Component) do
        begin
          if (ChannelMasks[Channel].Enabled) then
          begin
            if (ChannelMasks[Channel].Shift > 0) then
              NewValue := NewValue or ((Value shl ChannelMasks[Channel].Shift) and ChannelMasks[Channel].Mask)
            else
            if (ChannelMasks[Channel].Shift < 0) then
              NewValue := NewValue or ((Value shr -ChannelMasks[Channel].Shift) and ChannelMasks[Channel].Mask)
            else
              NewValue := NewValue or (Value and ChannelMasks[Channel].Mask);
          end else
            NewValue := NewValue or ChannelMasks[Channel].Mask; // Set alpha=255
        end;

        Pixels^ := NewValue;
        Inc(Pixels);
      end;

      Inc(Row, DeltaRow);
    end;

{$IFDEF RGBA_FORMAT}
    // For BI_BITFIELDS we do not need to swap the R and B channels at the end because
    // we have already done it by adjusting the Masks and ChannelToIndex arrays.
{$ENDIF}
  end;

  Result := True;
end;

procedure TCustomBitmap32.LoadFromStream(Stream: TStream);
var
  SavePos: Int64;
begin
  SavePos := Stream.Position;

  if (not ImageFormatManager.Readers.LoadFromStream(Self, Stream)) then
  begin
    Stream.Position := SavePos;
    raise Exception.Create(sUnknownImageFormat);
  end;

  Changed;
end;

procedure TCustomBitmap32.SaveToStream(Stream: TStream; SaveTopDown: Boolean);
begin
  SaveToStream(Stream, SaveTopDown, DefaultBitmapHeaderVersion);
end;

procedure TCustomBitmap32.SaveToStream(Stream: TStream; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion);
begin
  SaveToStream(Stream, SaveTopDown, InfoHeaderVersion, DefaultBitmapIncludeColorTable);
end;

procedure TCustomBitmap32.SaveToStream(Stream: TStream; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion; IncludeColorTable: boolean);
var
  StartPos: Int64;
  SavePos: Int64;
  FileHeader: TBitmapFileHeader;
begin
  StartPos := Stream.Position;

  // Skip past file header. We will write it once the DIB has been written.
  Stream.Seek(SizeOf(TBitmapFileHeader), soFromCurrent);

  // Save the DIB
  SaveToDIBStream(Stream, SaveTopDown, InfoHeaderVersion, IncludeColorTable);
  SavePos := Stream.Position;

  // Calculate size, store in header, rewind and write the file header
  FileHeader.bfType := $4D42; // Magic bytes for Windows Bitmap: 'BM'
  FileHeader.bfSize := Stream.Position - StartPos;
  FileHeader.bfReserved1 := 0;
  FileHeader.bfReserved2 := 0;
  // Most application doesn't care about the value in bfOffBits but some do and
  // for those (e.g. Gimp, MS Paint) it appears to be important that we store a
  // correct value. Without a correct value the applications are, for some reason,
  // unable to handle BI_BITFIELDS BMPs with a color table.
  FileHeader.bfOffBits := SizeOf(TBitmapFileHeader);
  case InfoHeaderVersion of
    InfoHeaderVersion1: Inc(FileHeader.bfOffBits, SizeOf(TBitmapInfoHeader));// 40
    InfoHeaderVersion2: Inc(FileHeader.bfOffBits, SizeOf(TBitmapV2Header));  // 52
    InfoHeaderVersion3: Inc(FileHeader.bfOffBits, SizeOf(TBitmapV3Header));  // 56
    InfoHeaderVersion4: Inc(FileHeader.bfOffBits, SizeOf(TBitmapV4Header));  // 108
    InfoHeaderVersion5: Inc(FileHeader.bfOffBits, SizeOf(TBitmapV5Header));  // 124
  end;
  if (IncludeColorTable) and (InfoHeaderVersion >= InfoHeaderVersion3) then
    Inc(FileHeader.bfOffBits, 3*SizeOf(DWORD));

  Stream.Position := StartPos;
  Stream.WriteBuffer(FileHeader, SizeOf(FileHeader));

  Stream.Position := SavePos;
end;

procedure TCustomBitmap32.SaveToDIBStream(Stream: TStream; SaveTopDown: Boolean; IncludeColorTable: boolean);
begin
  SaveToDIBStream(Stream, SaveTopDown, DefaultBitmapHeaderVersion, IncludeColorTable);
end;

procedure TCustomBitmap32.SaveToDIBStream(Stream: TStream; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion; IncludeColorTable: boolean);
type
  TDIBHeader = packed record
  case TInfoHeaderVersion of
    InfoHeaderVersion1: (InfoHeader: TBitmapInfoHeader);        // 40
    InfoHeaderVersion2: (V2Header: TBitmapV2Header);            // 52
    InfoHeaderVersion3: (V3Header: TBitmapV3Header);            // 56
    InfoHeaderVersion4: (V4Header: TBitmapV4Header);            // 108
    InfoHeaderVersion5: (V5Header: TBitmapV5Header);            // 124
  end;

const
  LCS_sRGB = $73524742; // 'sRGB'
{$IFDEF FPC}
  LCS_GM_IMAGES = 4;
{$ENDIF}

var
  Header: TDIBHeader;
  i: Integer;
  W: Integer;
{$ifdef RGBA_FORMAT}
  Colors: array of TColor32;
  Line: PColor32Array;
{$endif RGBA_FORMAT}
begin
  Header := Default(TDIBHeader);

  // Determine info header size based on header version.
  // Note: Formats lower than InfoHeaderVersion3 doesn't formally
  // support alpha but that doesn't mean that we can't store the alpha
  // anyway.
  case InfoHeaderVersion of
    InfoHeaderVersion1: Header.InfoHeader.biSize := SizeOf(TBitmapInfoHeader);// 40
    InfoHeaderVersion2: Header.InfoHeader.biSize := SizeOf(TBitmapV2Header);  // 52
    InfoHeaderVersion3: Header.InfoHeader.biSize := SizeOf(TBitmapV3Header);  // 56
    InfoHeaderVersion4: Header.InfoHeader.biSize := SizeOf(TBitmapV4Header);  // 108
    InfoHeaderVersion5: Header.InfoHeader.biSize := SizeOf(TBitmapV5Header);  // 124
  else
    raise Exception.Create('Invalid DIB header version');
  end;

  Header.InfoHeader.biWidth := Width;

  if SaveTopDown then
    Header.InfoHeader.biHeight := -Height
  else
    Header.InfoHeader.biHeight := Height;

  Header.InfoHeader.biPlanes := 1;
  Header.InfoHeader.biBitCount := 32; // This implementation only support writing 32-bit format
  Header.InfoHeader.biCompression := BI_RGB; // BI_RGB or BI_BITFIELDS
  Header.InfoHeader.biSizeImage := Width * Height * SizeOf(DWORD);
  Header.InfoHeader.biXPelsPerMeter := 0;
  Header.InfoHeader.biYPelsPerMeter := 0;
  Header.InfoHeader.biClrUsed := 0; // No palette
  Header.InfoHeader.biClrImportant := 0;

  if (InfoHeaderVersion >= InfoHeaderVersion3) then
  begin
    // First header version to formally support Alpha. But this requires that we use
    // BI_BITFIELDS compression.
    // Note though that Windows Explorer only recongnizes alpha in v4 and v5.
    Header.InfoHeader.biCompression := BI_BITFIELDS; // Switch from BI_RGB
    Header.V3Header.bV3AlphaMask := $FF000000;
  end;

  if (Header.InfoHeader.biCompression = BI_BITFIELDS) then
  begin
    // We only support the bit masks that correspond directly to the ABGR format.
    // Also note that WIC, among others, ignores the alpha if we use a different mask.
    Header.V2Header.bV2RedMask := $00FF0000;
    Header.V2Header.bV2GreenMask := $0000FF00;
    Header.V2Header.bV2BlueMask := $000000FF;
  end;

  if (InfoHeaderVersion >= InfoHeaderVersion4) then
    Header.V4Header.bV4CSType := LCS_sRGB;

  if (InfoHeaderVersion >= InfoHeaderVersion5) then
    Header.V5Header.bV5Intent := LCS_GM_IMAGES;

  Stream.WriteBuffer(Header, Header.InfoHeader.biSize);

  // Write the color table.
  // This just contains the same values as first three fields of the header color mask.
  //
  // Note that by default we never write the color table.
  // Empirical evidence has shown that, for most consistent results, neither bitmap files
  // (i.e. BMPs) nor DIBs (such as clipboard data) should contain the color table.
  //
  // The current MSDN documentation state that the color tables must always be present
  // for BI_BITFIELDS. However investigation of the relevant source code has revealed
  // that different parts of Windows has widely different implementations of the format;
  // The clipboard appears to always expect a color table while parts of GDI expect one
  // for v3 but not for v4 and v5 DIBs - or vice versa.
  //
  if (IncludeColorTable) and (Header.InfoHeader.biCompression = BI_BITFIELDS) then
    Stream.WriteBuffer(Header.V2Header.bV2RedMask, 3*SizeOf(DWORD)); // Actually, 3*SizeOf(TRGBQuad)

  // Pixel array
{$IFNDEF RGBA_FORMAT}
  if SaveTopDown then
  begin
    // NOTE: We can save the whole buffer in one run because
    // we do not support scanline strides (yet).
    Stream.WriteBuffer(Bits^, Header.InfoHeader.biSizeImage);
  end
  else
  begin
    W := Width * SizeOf(DWORD);
    for i := Height - 1 downto 0 do
      Stream.WriteBuffer(ScanLine[i]^, W);
  end;
{$ELSE RGBA_FORMAT}
  // Bits are in RGBA format but we need to write BGRA.
  SetLength(Colors, Width);
  for i := 0 to Height-1 do
  begin
    if SaveTopDown then
      Line := ScanLine[i]
    else
      Line := ScanLine[Height-i-1];
    for W := 0 to Width-1 do
      Colors[W] := SwapRedBlue(Line[W]);
    Stream.WriteBuffer(Colors[0], Width*SizeOf(DWORD));
  end;
{$ENDIF RGBA_FORMAT}
end;

procedure TCustomBitmap32.LoadFromFile(const FileName: string);
var
  FileStream: TFileStream;
begin
{$if (not defined(FPC)) and (CompilerVersion >= 31.0)} // TBufferedFileStream was introduced in Delphi 10.1
  FileStream := TBufferedFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
{$else}
  FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
{$ifend}
  try

    if (ImageFormatManager.Readers.LoadFromStream(Self, FileStream, FileName)) then
    begin
      Changed;
      exit;
    end else
    if (ImageFormatManager.Readers.LoadFromStream(Self, FileStream)) then
    begin
      Changed;
      exit;
    end;

  finally
    FileStream.Free;
  end;

  if (ImageFormatManager.Readers.LoadFromFile(Self, FileName)) then
  begin
    Changed;
    exit;
  end;

  raise Exception.Create(sUnknownImageFormat);
end;

procedure TCustomBitmap32.SaveToFile(const FileName: string);
var
  Extension: string;
  Writer: IImageFormatWriter;
  FileStream: TFileStream;
begin
  Extension := Copy(ExtractFileExt(FileName), 2, MaxInt);

  Writer := ImageFormatManager.Writers.FindWriter(Extension);

  if (Writer <> nil) then
  begin
    FileStream := TFileStream.Create(FileName, fmCreate);
    try
      Writer.SaveToStream(Self, FileStream);
    finally
      FileStream.Free;
    end;
  end else
    SaveToFile(FileName, False);
end;

procedure TCustomBitmap32.SaveToFile(const FileName: string; SaveTopDown: Boolean);
begin
  SaveToFile(FileName, SaveTopDown, DefaultBitmapHeaderVersion);
end;

procedure TCustomBitmap32.SaveToFile(const FileName: string; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion);
begin
  SaveToFile(FileName, SaveTopDown, InfoHeaderVersion, DefaultBitmapIncludeColorTable);
end;

procedure TCustomBitmap32.SaveToFile(const FileName: string; SaveTopDown: Boolean; InfoHeaderVersion: TInfoHeaderVersion; IncludeColorTable: boolean);
var
  FileStream: TFileStream;
begin
  // The purpose of this extra overload is primarily to allow the unit test to generate BMPs with/without a color table
  FileStream := TFileStream.Create(Filename, fmCreate);
  try
    SaveToStream(FileStream, SaveTopDown, InfoHeaderVersion, IncludeColorTable);
  finally
    FileStream.Free;
  end;
end;

procedure TCustomBitmap32.LoadFromResourceID(Instance: THandle; ResID: Integer; ResType: TResourceType);
var
  Stream: TStream;
begin
  Stream := TResourceStream.CreateFromID(Instance, ResID, ResType);
  try

    if (not ImageFormatManager.Readers.LoadFromResource(Self, ResType, Stream)) then
      raise Exception.Create(sUnknownImageFormat);

    Changed;

  finally
    Stream.Free;
  end;
end;

procedure TCustomBitmap32.LoadFromResourceName(Instance: THandle; const ResName: string; ResType: TResourceType);
var
  Stream: TStream;
begin
  Stream := TResourceStream.Create(Instance, ResName, ResType);
  try

    if (not ImageFormatManager.Readers.LoadFromResource(Self, ResType, Stream)) then
      raise Exception.Create(sUnknownImageFormat);

    Changed;

  finally
    Stream.Free;
  end;
end;

function TCustomBitmap32.Equal(B: TCustomBitmap32): Boolean;
var
  S1, S2: TMemoryStream;
begin
  Result := (B <> nil) and (ClassType = B.ClassType);

  if Empty or B.Empty then
  begin
    Result := Empty and B.Empty;
    Exit;
  end;

  if Result then
  begin
    S1 := TMemoryStream.Create;
    try
      SaveToStream(S1);
      S2 := TMemoryStream.Create;
      try
        B.SaveToStream(S2);
        Result := (S1.Size = S2.Size) and CompareMem(S1.Memory, S2.Memory, S1.Size);
      finally
        S2.Free;
      end;
    finally
      S1.Free;
    end;
  end;
end;

procedure TCustomBitmap32.DefineProperties(Filer: TFiler);

  function DoWrite: Boolean;
  begin
    if Filer.Ancestor <> nil then
      Result := not (Filer.Ancestor is TCustomBitmap32) or
        not Equal(TCustomBitmap32(Filer.Ancestor))
    else
      Result := not Empty;
  end;

begin
  Filer.DefineBinaryProperty('Data', ReadData, WriteData, DoWrite);
end;

procedure TCustomBitmap32.ReadData(Stream: TStream);
var
  Width, Height: Integer;
begin
  try
    Stream.ReadBuffer(Width, 4);
    Stream.ReadBuffer(Height, 4);
    SetSize(Width, Height);
    Stream.ReadBuffer(Bits[0], FWidth * FHeight * 4);
  finally
    Changed;
  end;
end;

procedure TCustomBitmap32.WriteData(Stream: TStream);
begin
  Stream.WriteBuffer(FWidth, 4);
  Stream.WriteBuffer(FHeight, 4);
  Stream.WriteBuffer(Bits[0], FWidth * FHeight * 4);
end;

procedure TCustomBitmap32.SetCombineMode(const Value: TCombineMode);
begin
  if FCombineMode <> Value then
  begin
    FCombineMode := Value;
    BlendProc := @BLEND_MEM[FCombineMode]^;
    Changed;
  end;
end;

procedure TCustomBitmap32.SetDrawMode(Value: TDrawMode);
begin
  if FDrawMode <> Value then
  begin
    FDrawMode := Value;
    Changed;
  end;
end;

procedure TCustomBitmap32.SetWrapMode(Value: TWrapMode);
begin
  if FWrapMode <> Value then
  begin
    FWrapMode := Value;
    WrapProcHorz := GetWrapProcEx(WrapMode, FClipRect.Left, FClipRect.Right - 1);
    WrapProcVert := GetWrapProcEx(WrapMode, FClipRect.Top, FClipRect.Bottom - 1);
    Changed;
  end;
end;

procedure TCustomBitmap32.SetMasterAlpha(Value: Cardinal);
begin
  if FMasterAlpha <> Value then
  begin
    FMasterAlpha := Value;
    Changed;
  end;
end;

procedure TCustomBitmap32.Roll(Dx, Dy: Integer; FillBack: Boolean; FillColor: TColor32);
var
  Shift, L: Integer;
  R: TRect;
begin
  if Empty or ((Dx = 0) and (Dy = 0)) then
    Exit;

  if not FMeasuringMode then
  begin
    if (Abs(Dx) >= Width) or (Abs(Dy) >= Height) then
    begin
      if FillBack then
        Clear(FillColor);

      Exit;
    end;

    Shift := Dx + Dy * Width;
    L := (Width * Height - Abs(Shift));

    if Shift > 0 then
      Move(Bits[0], Bits[Shift], L shl 2)
    else
      MoveLongword(Bits[-Shift], Bits[0], L);

    if FillBack then
    begin
      R := MakeRect(0, 0, Width, Height);
      OffsetRect(R, Dx, Dy);
      IntersectRect(R, R, MakeRect(0, 0, Width, Height));

      if R.Top > 0 then
        FillRect(0, 0, Width, R.Top, FillColor)
      else
      if R.Top = 0 then
        FillRect(0, R.Bottom, Width, Height, FillColor);

      if R.Left > 0 then
        FillRect(0, R.Top, R.Left, R.Bottom, FillColor)
      else
      if R.Left = 0 then
        FillRect(R.Right, R.Top, Width, R.Bottom, FillColor);
    end;
  end;

  Changed;
end;

procedure TCustomBitmap32.FlipHorz(Dst: TCustomBitmap32);
var
  i, j: Integer;
  P1, P2: PColor32;
  tmp: TColor32;
  W, W2: Integer;
begin
  W := Width;
  if (Dst = nil) or (Dst = Self) then
  begin
    if not FMeasuringMode then
    begin
      { In-place flipping }
      P1 := PColor32(Bits);
      P2 := P1;
      Inc(P2, Width - 1);
      W2 := Width shr 1;
      for J := 0 to Height - 1 do
      begin
        for I := 0 to W2 - 1 do
        begin
          tmp := P1^;
          P1^ := P2^;
          P2^ := tmp;
          Inc(P1);
          Dec(P2);
        end;
        Inc(P1, W - W2);
        Inc(P2, W + W2);
      end;
    end;
    Changed;
  end
  else
  begin
    Dst.BeginUpdate;
    { Flip to Dst }
    if not FMeasuringMode then
    begin
      Dst.SetSize(W, Height);
      P1 := PColor32(Bits);
      P2 := PColor32(Dst.Bits);
      Inc(P2, W - 1);
      for J := 0 to Height - 1 do
      begin
        for I := 0 to W - 1 do
        begin
          P2^ := P1^;
          Inc(P1);
          Dec(P2);
        end;
        Inc(P2, W shl 1);
      end;
    end;
    Dst.Changed;
    Dst.EndUpdate;
  end;
end;

procedure TCustomBitmap32.FlipVert(Dst: TCustomBitmap32);
var
  J, J2: Integer;
  Buffer: PColor32Array;
  P1, P2: PColor32;
begin
  // TODO : MeasuringMode
  if (Dst = nil) or (Dst = Self) then
  begin
    { in-place }
    if not FMeasuringMode then
    begin
      J2 := Height - 1;
      GetMem(Buffer, Width shl 2);
      for J := 0 to Height div 2 - 1 do
      begin
        P1 := PColor32(ScanLine[J]);
        P2 := PColor32(ScanLine[J2]);
        MoveLongword(P1^, Buffer^, Width);
        MoveLongword(P2^, P1^, Width);
        MoveLongword(Buffer^, P2^, Width);
        Dec(J2);
      end;
      FreeMem(Buffer);
    end;
    Changed;
  end
  else
  begin
    if not FMeasuringMode then
    begin
      Dst.SetSize(Width, Height);
      J2 := Height - 1;
      for J := 0 to Height - 1 do
      begin
        MoveLongword(ScanLine[J]^, Dst.ScanLine[J2]^, Width);
        Dec(J2);
      end;
    end;
    Dst.Changed;
  end;
end;

procedure TCustomBitmap32.Rotate90(Dst: TCustomBitmap32);
var
  Tmp: TCustomBitmap32;
  X, Y, I, J: Integer;
begin
  if not FMeasuringMode then
  begin
    if (Dst = nil) or (Dst = Self) then
    begin
      Tmp := TCustomBitmap32.Create; // TODO : Use TMemoryBackend
      Dst := Tmp;
    end else
      Tmp := nil;
    try

      Dst.BeginUpdate;
      try

        Dst.SetSize(Height, Width);
        I := 0;
        for Y := 0 to Height - 1 do
        begin
          J := Height - 1 - Y;
          for X := 0 to Width - 1 do
          begin
            Dst.Bits[J] := Bits[I];
            Inc(I);
            Inc(J, Height);
          end;
        end;

        Dst.Changed;
      finally
        Dst.EndUpdate;
      end;

    finally
      if (Tmp <> nil) then
      begin
        Tmp.CopyMapTo(Self);
        Tmp.Free;
      end;
    end;
  end else
  if (Dst = nil) or (Dst = Self) then
    Changed
  else
    Dst.Changed;
end;

procedure TCustomBitmap32.Rotate180(Dst: TCustomBitmap32);
var
  I, I2: Integer;
  Tmp: TColor32;
begin
  if (Dst <> nil) and (Dst <> Self) then
  begin
    if not FMeasuringMode then
    begin
      Dst.SetSize(Width, Height);
      I2 := Width * Height - 1;
      for I := 0 to Width * Height - 1 do
      begin
        Dst.Bits[I2] := Bits[I];
        Dec(I2);
      end;
    end;
    Dst.Changed;
  end
  else
  begin
    if not FMeasuringMode then
    begin
      I2 := Width * Height - 1;
      for I := 0 to Width * Height div 2 - 1 do
      begin
        Tmp := Bits[I2];
        Bits[I2] := Bits[I];
        Bits[I] := Tmp;
        Dec(I2);
      end;
    end;
    Changed;
  end;
end;

procedure TCustomBitmap32.Rotate270(Dst: TCustomBitmap32);
var
  Tmp: TCustomBitmap32;
  X, Y, I, J: Integer;
begin
  if not FMeasuringMode then
  begin
    if (Dst = nil) or (Dst = Self) then
    begin
      Tmp := TCustomBitmap32.Create; { TODO : Revise creating of temporary bitmaps here... }
       // TODO : Use TMemoryBackend
      Dst := Tmp;
    end else
      Tmp := nil;
    try

      Dst.BeginUpdate;
      try

        Dst.SetSize(Height, Width);
        I := 0;
        for Y := 0 to Height - 1 do
        begin
          J := (Width - 1) * Height + Y;
          for X := 0 to Width - 1 do
          begin
            Dst.Bits[J] := Bits[I];
            Inc(I);
            Dec(J, Height);
          end;
        end;

        Dst.Changed;
      finally
        Dst.EndUpdate;
      end;

    finally
      if (Tmp <> nil) then
      begin
        Tmp.CopyMapTo(Self);
        Tmp.Free;
      end;
    end;
  end else
  if (Dst = nil) or (Dst = Self) then
    Changed
  else
    Dst.Changed;
end;

function TCustomBitmap32.BoundsRect: TRect;
begin
  Result.Left := 0;
  Result.Top := 0;
  Result.Right := Width;
  Result.Bottom := Height;
end;

procedure TCustomBitmap32.SetClipRect(const Value: TRect);
begin
  IntersectRect(FClipRect, Value, BoundsRect);
  FFixedClipRect := FixedRect(FClipRect);
  with FClipRect do
    F256ClipRect := Rect(Left shl 8, Top shl 8, Right shl 8, Bottom shl 8);
  FClipping := not EqualRect(FClipRect, BoundsRect);
  WrapProcHorz := GetWrapProcEx(WrapMode, FClipRect.Left, FClipRect.Right - 1);
  WrapProcVert := GetWrapProcEx(WrapMode, FClipRect.Top, FClipRect.Bottom - 1);
end;

procedure TCustomBitmap32.ResetClipRect;
begin
  ClipRect := BoundsRect;
end;

procedure TCustomBitmap32.BeginMeasuring(const Callback: TAreaChangedEvent);
begin
  FMeasuringMode := True;
  FOldOnAreaChanged := FOnAreaChanged;
  FOnAreaChanged := Callback;
end;

procedure TCustomBitmap32.EndMeasuring;
begin
  FMeasuringMode := False;
  FOnAreaChanged := FOldOnAreaChanged;
end;

procedure TCustomBitmap32.PropertyChanged;
begin
  // don't force invalidation of whole bitmap area as this is unnecessary
  inherited Changed;
end;

procedure TCustomBitmap32.Changed;
begin
  if ((LockUpdateCount = 0) or FMeasuringMode) and Assigned(FOnAreaChanged) and (not Empty) then
    FOnAreaChanged(Self, BoundsRect, AREAINFO_RECT);

  if not FMeasuringMode then
    inherited;
end;

procedure TCustomBitmap32.Changed(const Area: TRect; const Info: Cardinal);
begin
  if ((LockUpdateCount = 0) or FMeasuringMode) and Assigned(FOnAreaChanged) and (not Empty) then
    FOnAreaChanged(Self, Area, Info);

  if not FMeasuringMode then
    inherited Changed;
end;

procedure TCustomBitmap32.SetResampler(AResampler: TCustomResampler);
begin
  if (AResampler <> nil) and (FResampler <> AResampler) then
  begin
    FResampler.Free;
    FResampler := AResampler;
    Changed;
  end;
end;

function TCustomBitmap32.GetResamplerClassName: string;
begin
  Result := FResampler.ClassName;
end;

procedure TCustomBitmap32.SetResamplerClassName(const Value: string);
var
  ResamplerClass: TCustomResamplerClass;
begin
  if (Value <> '') and (FResampler.ClassName <> Value) and (ResamplerList <> nil) then
  begin
    ResamplerClass := ResamplerList.Find(Value);
    if (ResamplerClass <> nil) then
      ResamplerClass.Create(Self);
  end;
end;

{ TBitmap32 }

procedure TBitmap32.FinalizeBackend;
var
  FontSupport: IFontSupport;
  CanvasSupport: ICanvasSupport;
begin
  if Supports(Backend, IFontSupport, FontSupport) then
  begin
    FontSupport.OnFontChange := nil;
    FontSupport := nil;
  end;

  if Supports(Backend, ICanvasSupport, CanvasSupport) then
  begin
    CanvasSupport.OnCanvasChange := nil;
    CanvasSupport := nil;
  end;

  inherited;
end;

procedure TBitmap32.BackendChangingHandler(Sender: TObject);
begin
  inherited;
  FontChanged(Self);
  DeleteCanvas;
end;

procedure TBitmap32.BackendChangedHandler(Sender: TObject);
begin
  inherited;
  HandleChanged;
end;

procedure TBitmap32.FontChanged(Sender: TObject);
begin
  // TODO: still required?
end;

procedure TBitmap32.CanvasChanged(Sender: TObject);
begin
  Changed;
end;

procedure TBitmap32.CopyPropertiesTo(Dst: TCustomBitmap32);
var
  FontSupport, DstFontSupport: IFontSupport;
begin
  inherited;

  if (Dst is TBitmap32) and
    Supports(Dst.Backend, IFontSupport, DstFontSupport) and Supports(Self.Backend, IFontSupport, FontSupport) then
    DstFontSupport.Font.Assign(FontSupport.Font);
end;

function TBitmap32.GetCanvas: TCanvas;
begin
  Result := (Backend as ICanvasSupport).Canvas;
end;

function TBitmap32.GetBitmapInfo: TBitmapInfo;
begin
  Result := (Backend as IBitmapContextSupport).BitmapInfo;
end;

function TBitmap32.GetHandle: HBITMAP;
begin
  Result := (Backend as IBitmapContextSupport).BitmapHandle;
end;

function TBitmap32.GetHDC: HDC;
begin
  Result := (Backend as IDeviceContextSupport).Handle;
end;

class function TBitmap32.GetPlatformBackendClass: TCustomBackendClass;
begin
{$if defined(FRAMEWORK_VCL)}
  Result := TGDIBackend;
{$elseif defined(FRAMEWORK_FMX)}
  Result := TMemoryBackend;
{$elseif defined(FRAMEWORK_LCL)}
  Result := TLCLBackend;
{$else}
  Result := inherited;
{$ifend}
end;

function TBitmap32.GetFont: TFont;
begin
  Result := (Backend as IFontSupport).Font;
end;

procedure TBitmap32.SetBackend(const ABackend: TCustomBackend);
var
  FontSupport: IFontSupport;
  CanvasSupport: ICanvasSupport;
begin
  if (ABackend <> nil) and (Backend <> ABackend) then
  begin
    if Supports(ABackend, IFontSupport, FontSupport) then
      FontSupport.OnFontChange := FontChanged;

    if Supports(ABackend, ICanvasSupport, CanvasSupport) then
      CanvasSupport.OnCanvasChange := CanvasChanged;

    inherited;
  end;
end;

procedure TBitmap32.SetFont(Value: TFont);
begin
  (Backend as IFontSupport).Font := Value;
end;

procedure TBitmap32.HandleChanged;
begin
  if Assigned(FOnHandleChanged) then
    FOnHandleChanged(Self);
end;

{$IFDEF BCB}
procedure TBitmap32.Draw(const DstRect, SrcRect: TRect; hSrc: Cardinal);
{$ELSE}
procedure TBitmap32.Draw(const DstRect, SrcRect: TRect; hSrc: HDC);
{$ENDIF}
begin
  (Backend as IDeviceContextSupport).Draw(DstRect, SrcRect, hSrc);
end;

procedure TBitmap32.DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; DstX, DstY: Integer);
begin
  if not Empty then
    (Backend as IDeviceContextSupport).DrawTo(hDst, DstX, DstY);
end;

procedure TBitmap32.DrawTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; const DstRect, SrcRect: TRect);
begin
  if not Empty then
    (Backend as IDeviceContextSupport).DrawTo(hDst, DstRect, SrcRect);
end;

procedure TBitmap32.TileTo(hDst: {$IFDEF BCB}Cardinal{$ELSE}HDC{$ENDIF}; const DstRect, SrcRect: TRect; MaxTileSize: integer);
var
  DstW, DstH: Integer;
  TilesX, TilesY: Integer;
  Buffer: TCustomBitmap32;
  I, J: Integer;
  ClipRect, R: TRect;
  X, Y: Integer;
  DeviceContextSupport: IDeviceContextSupport;
begin
  DstW := DstRect.Right - DstRect.Left;
  DstH := DstRect.Bottom - DstRect.Top;
  TilesX := (DstW + MaxTileSize - 1) div MaxTileSize;
  TilesY := (DstH + MaxTileSize - 1) div MaxTileSize;
  Buffer := TBitmap32.Create;
  try
    DeviceContextSupport := Buffer.Backend as IDeviceContextSupport;
    try
      for J := 0 to TilesY - 1 do
      begin
        for I := 0 to TilesX - 1 do
        begin
          ClipRect.Left := I * MaxTileSize;
          ClipRect.Top := J * MaxTileSize;
          ClipRect.Right := (I + 1) * MaxTileSize;
          ClipRect.Bottom := (J + 1) * MaxTileSize;
          if ClipRect.Right > DstW then
            ClipRect.Right := DstW;
          if ClipRect.Bottom > DstH then
            ClipRect.Bottom := DstH;
          X := ClipRect.Left;
          Y := ClipRect.Top;
          OffsetRect(ClipRect, -X, -Y);
          R := DstRect;
          OffsetRect(R, -X - DstRect.Left, -Y - DstRect.Top);
          Buffer.SetSize(ClipRect.Right, ClipRect.Bottom);
          StretchTransfer(Buffer, R, ClipRect, Self, SrcRect, Resampler, DrawMode, OnPixelCombine);

          DeviceContextSupport.DrawTo(hDst,
            MakeRect(X + DstRect.Left, Y + DstRect.Top, X + DstRect.Left+ClipRect.Right, Y + DstRect.Top+ClipRect.Bottom),
            Buffer.BoundsRect
          );
        end;
      end;

    finally
      DeviceContextSupport := nil;
    end;
  finally
    Buffer.Free;
  end;
end;

procedure TBitmap32.DrawTo(Dst: TControlCanvas; DstX, DstY: Integer);
begin
  DrawTo(Dst.Handle, DstX, DstY);
end;

procedure TBitmap32.DrawTo(Dst: TControlCanvas; const DstRect, SrcRect: TRect);
begin
  DrawTo(Dst.Handle, DstRect, SrcRect);
end;

procedure TBitmap32.TileTo(Dst: TControlCanvas; const DstRect, SrcRect: TRect; MaxTileSize: integer);
begin
  TileTo(Dst.Handle, DstRect, SrcRect, MaxTileSize);
end;

procedure TBitmap32.UpdateFont;
begin
  (Backend as IFontSupport).UpdateFont;
end;

// Text and Fonts //

function TBitmap32.TextExtent(const Text: string): TSize;
begin
  Result := (Backend as ITextSupport).TextExtent(Text);
end;

// -------------------------------------------------------------------

procedure TBitmap32.Textout(X, Y: Integer; const Text: string);
begin
  (Backend as ITextSupport).Textout(X, Y, Text);
end;

// -------------------------------------------------------------------

procedure TBitmap32.Textout(X, Y: Integer; const ClipRect: TRect; const Text: string);
begin
  (Backend as ITextSupport).Textout(X, Y, ClipRect, Text);
end;

// -------------------------------------------------------------------

procedure TBitmap32.Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string);
begin
  (Backend as ITextSupport).Textout(DstRect, Flags, Text);
end;

// -------------------------------------------------------------------

function TBitmap32.TextHeight(const Text: string): Integer;
begin
  Result := (Backend as ITextSupport).TextExtent(Text).cY;
end;

// -------------------------------------------------------------------

function TBitmap32.TextWidth(const Text: string): Integer;
begin
  Result := (Backend as ITextSupport).TextExtent(Text).cX;
end;

// -------------------------------------------------------------------

{$if not defined(USE_FONT_QUALITY)}
procedure SetFontAntialiasing(const Font: TFont; Quality: Cardinal);
var
  LogFont: TLogFont;
begin
  LogFont := Default(TLogFont);
  with LogFont do
  begin
    lfHeight := Font.Height;
    lfWidth := 0; { have font mapper choose }

    lfEscapement := Font.Orientation;
    lfOrientation := Font.Orientation;

    if fsBold in Font.Style then
      lfWeight := FW_BOLD
    else
      lfWeight := FW_NORMAL;

    lfItalic := Byte(fsItalic in Font.Style);
    lfUnderline := Byte(fsUnderline in Font.Style);
    lfStrikeOut := Byte(fsStrikeOut in Font.Style);
    lfCharSet := Byte(Font.Charset);

    if AnsiCompareText(Font.Name, 'Default') = 0 then  // do not localize
      StrLCopy(lfFaceName, @DefFontData.Name[1], LF_FACESIZE-1)
    else
      StrLCopy(lfFaceName, @Font.Name[1], LF_FACESIZE-1);

    lfQuality := Quality;

    { Only True Type fonts support the angles }
    if lfOrientation <> 0 then
      lfOutPrecision := OUT_TT_ONLY_PRECIS
    else
      lfOutPrecision := OUT_DEFAULT_PRECIS;

    lfClipPrecision := CLIP_DEFAULT_PRECIS;

    case Font.Pitch of
      fpVariable: lfPitchAndFamily := VARIABLE_PITCH;
      fpFixed: lfPitchAndFamily := FIXED_PITCH;
    else
      lfPitchAndFamily := DEFAULT_PITCH;
    end;
  end;
  Font.Handle := CreateFontIndirect(LogFont);
end;
{$ifend}

procedure TextBlueToAlpha(const B: TCustomBitmap32; Color: TColor32);
(*
asm
    PUSH    EDI
    MOV     ECX, [B+$44].Integer
    IMUL    ECX, [B+$40].Integer
    MOV     EDI, [B+$54].Integer
    @PixelLoop:
    MOV     EAX, [EDI]
    SHL     EAX, 24
    ADD     EAX, Color
    MOV     [EDI], EAX
    ADD     EDI, 4
    LOOP    @PixelLoop
    POP     EDI
end;
*)
var
  i: Integer;
  P: PColor32;
  Alpha: Byte;
begin
  // Convert green channel to alpha and fill the color.
  // We use the green channel instead of the blue in case the source
  // is ClearType anti-aliased.

  Color := Color and $00FFFFFF;
  P := PColor32(B.Bits);

  for i := 0 to B.Width * B.Height - 1 do
  begin
    Alpha := PColor32Entry(P).G;
    if Alpha <> 0 then
      P^ := (Alpha shl 24) or Color
    else
      P^ := 0;
    Inc(P);
  end;
end;

procedure TextScaleDown(const B, B2: TCustomBitmap32; const N: Integer;
  const Color: TColor32); // use only the blue channel
var
  I, J, X, Y, P, Q, Sz, S: Integer;
  Src: PColor32;
  Dst: PColor32;
begin
  Sz := 1 shl N - 1;
  Dst := PColor32(B.ScanLine[0]);
  for J := 0 to B.Height - 1 do
  begin
    Y := J shl N;
    for I := 0 to B.Width - 1 do
    begin
      X := I shl N;
      S := 0;
      for Q := Y to Y + Sz do
      begin
        Src := B2.PixelPtr[X, Q];
        for P := X to X + Sz do
        begin
          S := S + Integer(Src^ and $000000FF);
          Inc(Src);
        end;
      end;
      S := S shr N shr N;
      Dst^ := TColor32(S shl 24) + Color;
      Inc(Dst);
    end;
  end;
end;

procedure TBitmap32.RenderText(X, Y: Integer; const Text: string; Color: TColor32);
var
  B: TBitmap32;
  Sz: TSize;
  Alpha: TColor32;
begin
  if Empty then
    Exit;

  Alpha := TColor32Entry(Color).A;
  TColor32Entry(Color).A := 0;

  { TODO : Optimize Clipping here }
  B := TBitmap32.Create;
  try
    Sz := Self.TextExtent(Text) + Self.TextExtent(' ');
    B.SetSize(Sz.cX, Sz.cY);
    B.Font.Assign(Font);
    B.Clear(0);
    B.Font.Color := clWhite;

    B.Textout(0, 0, Text);
    TextBlueToAlpha(B, Color);

    B.DrawMode := dmBlend;
    B.MasterAlpha := Alpha;
    B.CombineMode := CombineMode;

    B.DrawTo(Self, X, Y);
  finally
    B.Free;
  end;
end;

procedure TBitmap32.RenderText(X, Y: Integer; const Text: string; Color: TColor32; AntiAlias: boolean);
var
  SaveQuality: TFontQuality;
begin
  if Empty then
    Exit;

  SaveQuality := Font.Quality;

{$if defined(USE_FONT_QUALITY)}
  if (AntiAlias) then
    Font.Quality := fqAntialiased
  else
    Font.Quality := fqNonAntialiased;
{$else}
  if (AntiAlias) then
    SetFontAntialiasing(Font, ANTIALIASED_QUALITY)
  else
    SetFontAntialiasing(Font, NONANTIALIASED_QUALITY);
{$ifend}
  try

    RenderText(X, Y, Text, Color);

  finally
{$if defined(USE_FONT_QUALITY)}
    Font.Quality := SaveQuality;
{$else}
    SetFontAntialiasing(Font, DEFAULT_QUALITY);
{$ifend}
  end;
end;

procedure TBitmap32.RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32);
var
  SaveQuality: TFontQuality;
begin
  if Empty then
    Exit;

  SaveQuality := Font.Quality;

  if (AALevel < 0) then
    Font.Quality := fqAntialiased
  else
    Font.Quality := fqNonAntialiased;
  try

    RenderText(X, Y, Text, Color);

  finally
    Font.Quality := SaveQuality;
  end;
end;

// -------------------------------------------------------------------

function TBitmap32.CanvasAllocated: Boolean;
var
  CanvasSupport: ICanvasSupport;
begin
  Result := Supports(Backend, ICanvasSupport, CanvasSupport) and CanvasSupport.CanvasAllocated;
end;

procedure TBitmap32.DeleteCanvas;
var
  CanvasSupport: ICanvasSupport;
begin
  if Supports(Backend, ICanvasSupport, CanvasSupport) then
    CanvasSupport.DeleteCanvas;
end;


{ TCustomBackend }

constructor TCustomBackend.Create;
begin
  RefCounted := True;
  _AddRef;
  inherited;
end;

constructor TCustomBackend.Create(Owner: TCustomBitmap32);
begin
  FOwner := Owner;
  Create;
  if (FOwner <> nil) then
    FOwner.Backend := Self;
end;

destructor TCustomBackend.Destroy;
begin
  Clear;
  inherited;
end;

procedure TCustomBackend.Clear;
var
  Width, Height: Integer;
begin
  if (FOwner <> nil) then
    ChangeSize(FOwner.FWidth, FOwner.FHeight, 0, 0, False)
  else
    ChangeSize(Width, Height, 0, 0, False);
end;

procedure TCustomBackend.Changing;
begin
  if Assigned(FOnChanging) then
    FOnChanging(Self);
end;

{$IFDEF BITS_GETTER}
function TCustomBackend.GetBits: PColor32Array;
begin
  Result := FBits;
end;
{$ENDIF}

procedure TCustomBackend.ChangeSize(out Width, Height: Integer; NewWidth, NewHeight: Integer; ClearBuffer: Boolean);
begin
  try
    Changing;

    FinalizeSurface;

    Width := 0;
    Height := 0;

    if (NewWidth > 0) and (NewHeight > 0) then
      InitializeSurface(NewWidth, NewHeight, ClearBuffer);

    Width := NewWidth;
    Height := NewHeight;
  finally
    Changed;
  end;
end;

procedure TCustomBackend.Assign(Source: TPersistent);
var
  SrcBackend: TCustomBackend;
begin
  if Source is TCustomBackend then
  begin
    if (FOwner <> nil) then
    begin
      SrcBackend := TCustomBackend(Source);

      ChangeSize(
        FOwner.FWidth, FOwner.FHeight,
        SrcBackend.FOwner.Width, SrcBackend.FOwner.Height,
        False
      );

      if not SrcBackend.Empty then
        MoveLongword(
          SrcBackend.Bits[0], Bits[0],
          SrcBackend.FOwner.Width * SrcBackend.FOwner.Height
        );
    end;
  end else
    inherited;
end;

function TCustomBackend.Empty: Boolean;
begin
  Result := False;
end;

procedure TCustomBackend.FinalizeSurface;
begin
  // descendants override this method
end;

procedure TCustomBackend.InitializeSurface(NewWidth, NewHeight: Integer; ClearBuffer: Boolean);
begin
  // descendants override this method
end;

procedure TCustomBackend.SetOwner(AOwner: TCustomBitmap32);
begin
  FOwner := AOwner;
end;

{ TCustomSampler }

function TCustomSampler.GetSampleInt(X, Y: Integer): TColor32;
begin
  Result := GetSampleFixed(X * FixedOne, Y * FixedOne);
end;

function TCustomSampler.GetSampleFixed(X, Y: TFixed): TColor32;
begin
  Result := GetSampleFloat(X * FixedToFloat, Y * FixedToFloat);
end;

function TCustomSampler.GetSampleFloat(X, Y: TFloat): TColor32;
begin
  Result := GetSampleFixed(Fixed(X), Fixed(Y));
end;

procedure TCustomSampler.PrepareSampling;
begin
  // descendants override this method
end;

procedure TCustomSampler.FinalizeSampling;
begin
  // descendants override this method
end;

function TCustomSampler.HasBounds: Boolean;
begin
  Result := False;
end;

function TCustomSampler.GetSampleBounds: TFloatRect;
const
  InfRect: TFloatRect = (Left: -Infinity; Top: -Infinity; Right: Infinity; Bottom: Infinity);
begin
  Result := InfRect;
end;


{ TCustomResampler }

constructor TCustomResampler.Create;
begin
  inherited;
  FPixelAccessMode := pamSafe;
end;

constructor TCustomResampler.Create(ABitmap: TCustomBitmap32);
begin
  Create;
  FBitmap := ABitmap;
  if (FBitmap <> nil) then
    FBitmap.Resampler := Self;
end;

procedure TCustomResampler.DoChanged;
begin
  if (FBitmap <> nil) then
    FBitmap.Changed;
end;

procedure TCustomResampler.AssignTo(Dst: TPersistent);
begin
  if Dst is TCustomResampler then
    SmartAssign(Self, Dst)
  else
    inherited;
end;

function TCustomResampler.GetSampleBounds: TFloatRect;
begin
  Result := FloatRect(FBitmap.ClipRect);
  if PixelAccessMode = pamTransparentEdge then
    InflateRect(Result, 1, 1);
end;

function TCustomResampler.GetWidth: TFloat;
begin
  Result := 0;
end;

function TCustomResampler.HasBounds: Boolean;
begin
  Result := FPixelAccessMode <> pamWrap;
end;

procedure TCustomResampler.PrepareSampling;
begin
  FClipRect := FBitmap.ClipRect;
end;

procedure TCustomResampler.SetPixelAccessMode(
  const Value: TPixelAccessMode);
begin
  if FPixelAccessMode <> Value then
  begin
    FPixelAccessMode := Value;
    Changed;
  end;
end;


//------------------------------------------------------------------------------
//
//      Bindings
//
//------------------------------------------------------------------------------
procedure RegisterBindings;
begin
{$if (not defined(PUREPASCAL)) and (not defined(OMIT_SSE2))}
  GeneralRegistry.RegisterBinding(@@FastPrevWeight, 'FastPrevWeight');
{$ifend}
end;

var
  FGeneralRegistry: TFunctionRegistry = nil;

function GeneralRegistry: TFunctionRegistry;
begin
  if (FGeneralRegistry = nil) then
  begin
    FGeneralRegistry := NewRegistry('GR32 misc. bindings');
    RegisterBindings;
  end;
  Result := FGeneralRegistry;
end;

//------------------------------------------------------------------------------
//
//      Function bindings
//
//------------------------------------------------------------------------------
procedure RegisterBindingFunctions;
begin
{$if (not defined(PUREPASCAL)) and (not defined(OMIT_SSE2))}
  // For PUREPASCAL FastPrevWeight is inlined and thus doesn't use the binding system
  GeneralRegistry[@@FastPrevWeight].Add(@FastPrevWeight_Pas,    [isPascal]);
  GeneralRegistry[@@FastPrevWeight].Add(@FastPrevWeight_SSE41,  [isSSE41]);
{$ifend}
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

initialization
  RegisterBindingFunctions;
  GeneralRegistry.RebindAll;

  SetGamma;
  StockBitmap := TBitmap.Create;
  StockBitmap.Width := 8;
  StockBitmap.Height := 8;

finalization
  StockBitmap.Free;

end.