unit transparentCanvas;

{
  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.

  The Original Code is an alpha-aware canvas class and associated classes.

  The Initial Developer of the Original Code is David Millington.
  Portions created by David Millington are Copyright (C) 2008-2012.
  All Rights Reserved.

  Contributor(s): David Millington.
  Frank Staal
}

interface

uses
  SysUtils, Classes, Types, Windows,

  VCL.Controls, VCL.Graphics,


{$IF CompilerVersion >= 23.0} // XE2
  UITypes // Let inline function TFont.GetStyle be expanded
{$ENDIF};

type
  ETransparentCanvasException = class(Exception)
  end;

  TQuadColor = record
    constructor Create(Color: TColor);
    procedure Clear;
    function WrittenByGDI: Boolean;
    procedure SetAlpha(const Transparency: Byte; const PreMult: Single);
    function AsColorRef: COLORREF;
    procedure SetFromColorRef(const Color: COLORREF);
    procedure SetFromColorMultAlpha(const Color: TQuadColor);

    case Boolean of
      // These values are not in the same order as COLORREF RGB values - don't assign from a COLORREF directly
      True:
        (Blue, Green, Red, Alpha: Byte
        );
      False:
        (Quad: Cardinal);
  end;

  PQuadColor = ^TQuadColor;
  PPQuadColor = ^PQuadColor;

  TGDIObjects = record
  private
    FBrush: HBRUSH;
    FPen: HPEN;
    FFont: HFONT;
  public
    constructor CreateWithHandles(const HBRUSH: HBRUSH; const HPEN: HPEN;
      const HFONT: HFONT);
    property Brush: HBRUSH read FBrush;
    property Pen: HPEN read FPen;
    property Font: HFONT read FFont;
  end;

  TAlphaBitmapWrapper = class(TPersistent)
  private
    FDCHandle: HDC;
    FBMPHandle, FOriginalBMP: HBitmap;
    FQuads: PQuadColor;
    FWidth, FHeight: Integer;
    FOriginalObjects: TGDIObjects;

    procedure Construct(DC: HDC; Empty: Boolean; Width, Height: Integer;
      Inverted: Boolean = False);
    procedure CheckHandles;
    procedure Clear;
  public
    constructor CreateBlank(DC: HDC; Width, Height: Integer);
    // The DummyX parameters are to avoid duplicate constructors with the same parameter list being
    // inaccessible from C++, although only necessary if you write C++ code that uses this (internal)
    // class
    constructor CreateForGDI(DC: HDC; Width, Height: Integer;
      DummyGDI: Byte = 0);
    constructor CreateForDrawThemeTextEx(DC: HDC; Width, Height: Integer;
      DummyDrawThemeTextEx: SmallInt = 0);
    constructor Create(var ToCopy: TAlphaBitmapWrapper);
    destructor Destroy; override;

    procedure SelectObjects(const GDI: TGDIObjects);
    procedure SelectOriginalObjects;

    procedure SetAllTransparency(const Alpha: Byte);
    procedure ProcessTransparency(const Alpha: Byte); overload;
    procedure ProcessTransparency(const Alpha: Byte;
      TranspRect: TRect); overload;
    procedure ProcessMaskTransparency(var MaskImage: TAlphaBitmapWrapper);
    procedure ProcessTransparentColor(const TransparentColor: COLORREF;
      const TransparentEdgeWidth: Integer = -1);
    procedure TintByAlphaToColor(const Color: TQuadColor);
    procedure BlendTo(X, Y: Integer; var Image: TAlphaBitmapWrapper;
      Transparency: Byte = $FF);
    procedure BlendToStretch(X, Y, StretchWidth, StretchHeight: Integer;
      var Image: TAlphaBitmapWrapper; Transparency: Byte);
    procedure BlendToDC(X, Y: Integer; DC: HDC; Transparency: Byte = $FF);

    function GetRawPixelPtr(const X, Y: Integer): PQuadColor;
    procedure SafeSetRawPixel(const X, Y: Integer; Color: TQuadColor);
  published
    property Handle: HDC read FDCHandle;
    property BitmapHandle: HBitmap read FBMPHandle;
    function QuadPointer: PQuadColor;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
  end;

  TCustomTransparentCanvas = class(TPersistent)
    class function TColorToQuadColor(Color: TColor): TQuadColor;
    class function QuadColorToTColor(Color: TQuadColor): TColor;
  private
    FFont: TFont;
    FBrush: TBrush;
    FPen: TPen;
    FAttachedDC: HDC;

    function GetHandle(): HDC;

    procedure SetFont(NewFont: TFont);
    procedure SetBrush(NewBrush: TBrush);
    procedure SetPen(NewPen: TPen);

    function GetPenPos: TPoint;
    procedure SetPenPos(NewPos: TPoint);

    function GetWidth: Integer;
    function GetHeight: Integer;

    // Converts to non-premultiplied alpha
    function GetPixel(X, Y: Integer): COLORREF;
    procedure SetPixel(X, Y: Integer; Color: Cardinal); overload;
    procedure SetPixel(X, Y: Integer; Color: Cardinal; Alpha: Byte); overload;

    // Direct pre-multiplied alpha
    function GetRawPixel(X, Y: Integer): TQuadColor;
    procedure SetRawPixel(X, Y: Integer; Color: TQuadColor);

    procedure TextOutPreVista(const Rect: TRect; const Text: string;
      const Alignment: TAlignment; const Alpha: Byte);
    procedure TextOutVistaPlus(const ARect: TRect; const Text: string;
      const Alignment: TAlignment; const Alpha: Byte);
    function CanUseDrawThemeTextEx: Boolean;
    procedure InternalGlowTextOut(const X, Y, GlowSize: Integer;
      const Text: string; const Alignment: TAlignment; const Alpha: Byte;
      const ProcessBackColor: Boolean; const BackColor: TQuadColor); overload;
    procedure InternalGlowTextOut(const ARect: TRect; const GlowSize: Integer;
      const Text: string; const Alignment: TAlignment; const Alpha: Byte;
      const ProcessBackColor: Boolean; const BackColor: TQuadColor); overload;
  protected
    FWorkingCanvas: TAlphaBitmapWrapper;

    function OrphanAliasedFont: HFONT;
  public
    constructor Create(Width, Height: Integer); overload;
    constructor Create(Canvas: TCanvas); overload;
    constructor Create(DC: HDC; Width, Height: Integer); overload;
    constructor Create(ToCopy: TCustomTransparentCanvas); overload;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    procedure AssignTo(Dest: TPersistent); override;

    procedure SaveToFile(const Filename: string);

    procedure Draw(const X, Y: Integer; Canvas: TCanvas;
      const Width, Height: Integer; const UseTransparentColor: Boolean = False;
      const TransparentColor: COLORREF = $0;
      const TransparentEdgeWidth: Integer = -1); overload;
    procedure Draw(const X, Y: Integer; const Metafile: TMetafile;
      const Width, Height: Integer; const Transparency: Byte = $FF); overload;
    procedure Draw(const X, Y: Integer; Other: TCustomTransparentCanvas;
      const Transparency: Byte = 255); overload;

    procedure DrawTo(const X, Y: Integer; Canvas: TCanvas;
      const TargetWidth, TargetHeight: Integer;
      const Transparency: Byte = $FF); overload;
    procedure DrawTo(const X, Y: Integer; DC: HDC;
      const TargetWidth, TargetHeight: Integer;
      const Transparency: Byte = $FF); overload;
    procedure DrawToGlass(const X, Y: Integer; DC: HDC;
      const Transparency: Byte = $FF);

    procedure Ellipse(const X1, Y1, X2, Y2: Integer;
      const Alpha: Byte = $FF); overload;
    procedure Ellipse(const Rect: TRect; const Alpha: Byte = $FF); overload;

    procedure Polygon(const Polygon: array of TPoint;
      const X1, Y1, X2, Y2: Integer; const Alpha: Byte); overload;

    procedure Polyline(const Polygon: array of TPoint;
      const X1, Y1, X2, Y2: Integer; const Alpha: Byte); overload;

    procedure LineTo(const X1, Y1, X2, Y2: Integer; const Alpha: Byte);
      overload;

    procedure MoveTo(const X, Y: Integer);

    procedure RoundRect(const X1, Y1, X2, Y2, XRadius, YRadius: Integer;
      const Alpha: Byte = $FF); overload;
    procedure RoundRect(const Rect: TRect; const XRadius, YRadius: Integer;
      const Alpha: Byte = $FF); overload;
    procedure Rectangle(const X1, Y1, X2, Y2: Integer;
      const Alpha: Byte = $FF); overload;
    procedure Rectangle(const Rect: TRect; const Alpha: Byte = $FF); overload;

    function TextExtent(const Text: string): TSize;
    function TextHeight(const Text: string): Integer;
    procedure TextOut(const X, Y: Integer; const Text: string;
      const Alignment: TAlignment = taLeftJustify; const Alpha: Byte = $FF);
    procedure TextRect(const Rect: TRect; const Text: string;
      const Alignment: TAlignment = taLeftJustify; const Alpha: Byte = $FF);
    function TextWidth(const Text: string): Integer;

    function CanDrawGlowText: Boolean;
    procedure GlowTextOut(const X, Y, GlowSize: Integer; const Text: string;
      const Alignment: TAlignment = taLeftJustify; const Alpha: Byte = $FF);
    procedure GlowTextOutBackColor(const X, Y, GlowSize: Integer;
      const Text: string; const BackColor: TColor;
      const Alignment: TAlignment = taLeftJustify; const GlowAlpha: Byte = $FF;
      const Alpha: Byte = $FF);

    procedure Clear;

    property Handle: HDC read GetHandle;
    property PenPos: TPoint read GetPenPos write SetPenPos;
    property Pixels[X, Y: Integer]: COLORREF read GetPixel write SetPixel;
    property RawPixels[X, Y: Integer]: TQuadColor read GetRawPixel
      write SetRawPixel;
  published
    property Brush: TBrush read FBrush write SetBrush;
    property Font: TFont read FFont write SetFont;
    property Pen: TPen read FPen write SetPen;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
  end;

  TTransparentCanvas = class(TCustomTransparentCanvas)
  end;

  TTransparentControlCanvas = class(TCustomTransparentCanvas)
  private
    FControl: TWinControl;
    FControlDC: HDC;
  public
    constructor Create(Control: TWinControl);
    destructor Destroy; override;
  end;

implementation

uses
  Math, VCL.Themes, UxTheme, RTLConsts;

{$IF CompilerVersion >= 23.0}

// XE2
function InternalStyleServices: TCustomStyleServices;
begin
{$IF declared(StyleServices)}
  Result := StyleServices;
{$ELSE}
  Result := ThemeServices; // Deprecated in favour of StyleServices
{$IFEND}
end;
{$ELSE}

function InternalStyleServices: TThemeServices;
begin
  Result := ThemeServices;
end;
{$IFEND}

function AlignmentToFlags(const Alignment: TAlignment): DWORD;
begin
  Result := 0;
  case Alignment of
    taLeftJustify:
      Result := DT_LEFT;
    taRightJustify:
      Result := DT_RIGHT;
    taCenter:
      Result := DT_CENTER;
  end;
end;

{ TCustomTransparentCanvas }

function TCustomTransparentCanvas.CanDrawGlowText: Boolean;
begin
  Result := CanUseDrawThemeTextEx;
end;

function TCustomTransparentCanvas.CanUseDrawThemeTextEx: Boolean;
begin
  Result :=
{$IF declared(StyleServices)} // Can't test TCustomStyleServices.Enabled, assume deprecation follows StyleServices
    InternalStyleServices.Enabled
{$ELSE}
    InternalStyleServices.ThemesEnabled
{$IFEND}
    and (Win32MajorVersion >= 6);
end;

procedure TCustomTransparentCanvas.Clear;
begin
  FWorkingCanvas.Clear;
end;

constructor TCustomTransparentCanvas.Create(Width, Height: Integer);
begin
  inherited Create();
  FWorkingCanvas := TAlphaBitmapWrapper.CreateBlank(0, Width, Height);
  FFont := TFont.Create;
  FBrush := TBrush.Create;
  FPen := TPen.Create;
  FAttachedDC := 0;
end;

constructor TCustomTransparentCanvas.Create(ToCopy: TCustomTransparentCanvas);
begin
  inherited Create();
  FWorkingCanvas := TAlphaBitmapWrapper.Create(ToCopy.FWorkingCanvas);
  FFont := TFont.Create;
  FFont.Assign(ToCopy.FFont);
  FBrush := TBrush.Create;
  FBrush.Assign(ToCopy.FBrush);
  FPen := TPen.Create;
  FPen.Assign(ToCopy.FPen);
  FAttachedDC := 0;
end;

constructor TCustomTransparentCanvas.Create(Canvas: TCanvas);
begin
  inherited Create();
  FAttachedDC := Canvas.Handle;
  FWorkingCanvas := TAlphaBitmapWrapper.CreateBlank(Canvas.Handle,
    Width, Height);
  FFont := TFont.Create;
  FBrush := TBrush.Create;
  FPen := TPen.Create;
end;

constructor TCustomTransparentCanvas.Create(DC: HDC; Width, Height: Integer);
begin
  inherited Create();
  FAttachedDC := DC;
  FWorkingCanvas := TAlphaBitmapWrapper.CreateBlank(DC, Width, Height);
  FFont := TFont.Create;
  FBrush := TBrush.Create;
  FPen := TPen.Create;
end;

destructor TCustomTransparentCanvas.Destroy;
begin
  FreeAndNil(FWorkingCanvas);
  FreeAndNil(FFont);
  FreeAndNil(FBrush);
  FreeAndNil(FPen);

  inherited;
end;

procedure TCustomTransparentCanvas.Assign(Source: TPersistent);
var
  ToCopy: TCustomTransparentCanvas;
begin
  if Source is TCustomTransparentCanvas then
  begin
    ToCopy := Source as TCustomTransparentCanvas;

    FWorkingCanvas.Free;
    FWorkingCanvas := TAlphaBitmapWrapper.Create(ToCopy.FWorkingCanvas);
    assert(Assigned(FFont) and Assigned(FBrush) and Assigned(FPen));
    FFont.Assign(ToCopy.FFont);
    FBrush.Assign(ToCopy.FBrush);
    FPen.Assign(ToCopy.FPen);
    FAttachedDC := 0;
  end
  else
  begin
    if Assigned(Source) then
      raise EConvertError.CreateResFmt(@RTLConsts.SAssignError,
        [Source.ClassName, ClassName])
    else
      raise EConvertError.CreateResFmt(@RTLConsts.SAssignError,
        ['nil', ClassName]);
  end;
end;

procedure TCustomTransparentCanvas.AssignTo(Dest: TPersistent);
begin
  Dest.Assign(Self);
end;

procedure TCustomTransparentCanvas.SaveToFile(const Filename: string);
var
  BMP: TBitmap;
begin
  // Draw to a transparent 32-bit bitmap, and save that
  BMP := TBitmap.Create;
  try
    BMP.PixelFormat := pf32bit;
    BMP.Width := Width;
    BMP.Height := Height;
    DrawTo(0, 0, BMP.Canvas, Width, Height);
    BMP.SaveToFile(Filename);
  finally
    BMP.Free;
  end;
end;

procedure TCustomTransparentCanvas.Draw(const X, Y: Integer; Canvas: TCanvas;
  const Width, Height: Integer; const UseTransparentColor: Boolean;
  const TransparentColor: COLORREF; const TransparentEdgeWidth: Integer);
var
  TempImage: TAlphaBitmapWrapper;
begin
  TempImage := TAlphaBitmapWrapper.CreateForGDI(FWorkingCanvas.FDCHandle,
    Width, Height);
  try
    BitBlt(TempImage.FDCHandle, 0, 0, Width, Height, Canvas.Handle, 0,
      0, SRCCOPY);
    TempImage.SetAllTransparency($FF); // No need to test, all written by GDI
    if UseTransparentColor then
      TempImage.ProcessTransparentColor(TransparentColor, TransparentEdgeWidth);
    TempImage.BlendTo(X, Y, FWorkingCanvas);
  finally
    TempImage.Free;
  end;
end;

procedure TCustomTransparentCanvas.Draw(const X, Y: Integer;
  const Metafile: TMetafile; const Width, Height: Integer;
  const Transparency: Byte = $FF);
var
  TempImage: TAlphaBitmapWrapper;
begin
  TempImage := TAlphaBitmapWrapper.CreateForGDI(FWorkingCanvas.FDCHandle,
    Width, Height);
  try
    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(Brush.Handle,
      Pen.Handle, Font.Handle));
    try
      PlayEnhMetaFile(TempImage.FDCHandle, Metafile.Handle,
        Rect(0, 0, Width, Height));
      TempImage.ProcessTransparency(Transparency);
      TempImage.BlendTo(X, Y, FWorkingCanvas);
    finally
      TempImage.SelectOriginalObjects;
    end;
  finally
    TempImage.Free;
  end;
end;

procedure TCustomTransparentCanvas.Draw(const X, Y: Integer;
  Other: TCustomTransparentCanvas; const Transparency: Byte = 255);
begin
  Other.FWorkingCanvas.BlendTo(X, Y, FWorkingCanvas, Transparency);
end;

procedure TCustomTransparentCanvas.DrawTo(const X, Y: Integer; Canvas: TCanvas;
  const TargetWidth, TargetHeight: Integer; const Transparency: Byte = 255);
begin
  DrawTo(X, Y, Canvas.Handle, TargetWidth, TargetHeight, Transparency);
end;

procedure TCustomTransparentCanvas.DrawTo(const X, Y: Integer; DC: HDC;
  const TargetWidth, TargetHeight: Integer; const Transparency: Byte = 255);
var
  TempCanvas: TAlphaBitmapWrapper;
begin
  // Create a 32-bit canvas with a copy of the dc drawn in it with opaque alpha
  TempCanvas := TAlphaBitmapWrapper.CreateBlank(DC, TargetWidth, TargetHeight);
  try
    BitBlt(TempCanvas.FDCHandle, 0, 0, TargetWidth, TargetHeight, DC, 0,
      0, SRCCOPY);
    TempCanvas.SetAllTransparency($FF);

    // Now blend the working image onto it at (X, Y), possibly stretched
    if (TargetWidth = Width) and (TargetHeight = Height) then
    begin
      FWorkingCanvas.BlendTo(X, Y, TempCanvas, Transparency);
    end
    else
    begin
      FWorkingCanvas.BlendToStretch(X, Y, TargetWidth, TargetHeight, TempCanvas,
        Transparency);
    end;

    // Now blit the composited image back to the DC
    BitBlt(DC, 0, 0, TargetWidth, TargetHeight, TempCanvas.FDCHandle, 0,
      0, SRCCOPY);
  finally
    TempCanvas.Free;
  end;
end;

procedure TCustomTransparentCanvas.DrawToGlass(const X, Y: Integer; DC: HDC;
  const Transparency: Byte);
begin
  FWorkingCanvas.BlendToDC(X, Y, DC, Transparency);
end;

procedure TCustomTransparentCanvas.Ellipse(const X1, Y1, X2, Y2: Integer;
  const Alpha: Byte);
var
  TempImage: TAlphaBitmapWrapper;
begin

  TempImage := TAlphaBitmapWrapper.CreateForGDI(FWorkingCanvas.FDCHandle,
    X2 - X1, Y2 - Y1);

  try
    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(Brush.Handle,
      Pen.Handle, Font.Handle));
    SetWindowOrgEx(TempImage.FDCHandle, X1 - Pen.Width div 2,
      Y1 - Pen.Width div 2, nil);
    Windows.Ellipse(TempImage.FDCHandle, X1, Y1, X2, Y2);
    SetWindowOrgEx(TempImage.FDCHandle, 0, 0, nil);
    TempImage.ProcessTransparency(Alpha);
    TempImage.BlendTo(X1, Y1, FWorkingCanvas);
    TempImage.SelectOriginalObjects;
  finally
    TempImage.Free;
  end;

end;

procedure TCustomTransparentCanvas.Ellipse(const Rect: TRect;
  const Alpha: Byte);
begin
  Ellipse(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, Alpha);
end;

function TCustomTransparentCanvas.GetHandle: HDC;
begin
  Result := FWorkingCanvas.FDCHandle;
end;

function TCustomTransparentCanvas.GetHeight: Integer;
begin
  Result := FWorkingCanvas.FHeight;
end;

function TCustomTransparentCanvas.GetPenPos: TPoint;
begin
  GetCurrentPositionEx(FWorkingCanvas.FDCHandle, @Result);
end;

function TCustomTransparentCanvas.GetPixel(X, Y: Integer): COLORREF;
begin
  Result := GetRawPixel(X, Y).AsColorRef;
end;

function TCustomTransparentCanvas.GetRawPixel(X, Y: Integer): TQuadColor;
var
  PQuad: PQuadColor;
  InverseY: Integer;
begin
  InverseY := FWorkingCanvas.FHeight - Y - 1; // 0 is top not bottom
  PQuad := FWorkingCanvas.FQuads;
  Inc(PQuad, (InverseY * Width) + X);
  Result := PQuad^;
end;

function TCustomTransparentCanvas.GetWidth: Integer;
begin
  Result := FWorkingCanvas.FWidth;
end;

procedure TCustomTransparentCanvas.InternalGlowTextOut(const X, Y,
  GlowSize: Integer; const Text: string; const Alignment: TAlignment;
  const Alpha: Byte; const ProcessBackColor: Boolean;
  const BackColor: TQuadColor);
var
  TextSize: TSize;
begin
  TextSize := TextExtent(Text);
  InternalGlowTextOut(Rect(X, Y, X + TextSize.cx, Y + TextSize.cy), GlowSize,
    Text, Alignment, Alpha, ProcessBackColor, BackColor);
end;

procedure TCustomTransparentCanvas.InternalGlowTextOut(const ARect: TRect;
  const GlowSize: Integer; const Text: string; const Alignment: TAlignment;
  const Alpha: Byte; const ProcessBackColor: Boolean;
  const BackColor: TQuadColor);
var
  TempImage: TAlphaBitmapWrapper;
  TextSize: TSize;
  Options: TDTTOpts;
  Details: TThemedElementDetails;
  TextRect: TRect;
  AlignFlags: DWORD;
begin
  if Length(Text) = 0 then
    Exit; // Crash creating zero-sized bitmap
  if not CanDrawGlowText then
    raise ETransparentCanvasException.Create('Cannot use DrawThemeTextEx');

  TextSize := ARect.Size;
  AlignFlags := AlignmentToFlags(Alignment);
  TempImage := TAlphaBitmapWrapper.CreateForDrawThemeTextEx
    (FWorkingCanvas.FDCHandle, TextSize.cx + GlowSize * 2,
    TextSize.cy + GlowSize * 2);
  try
    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(0, 0, Font.Handle));
    SetBkMode(TempImage.FDCHandle, TRANSPARENT);
    SetTextColor(TempImage.FDCHandle, ColorToRGB(Font.Color));

    ZeroMemory(@Options, SizeOf(Options));
    Options.dwSize := SizeOf(Options);
    Options.dwFlags := DTT_TEXTCOLOR or DTT_COMPOSITED or DTT_GLOWSIZE;
    Options.crText := ColorToRGB(Font.Color);
    Options.iGlowSize := GlowSize;

    Details := InternalStyleServices.GetElementDetails(teEditTextNormal);
    TextRect := Rect(GlowSize, GlowSize, TextSize.cx + GlowSize * 2,
      TextSize.cy + GlowSize * 2);
    DrawThemeTextEx(InternalStyleServices.Theme[teEdit], TempImage.FDCHandle,
      Details.Part, Details.State, PChar(Text), Length(Text),
      AlignFlags or DT_TOP or DT_NOCLIP, TextRect, Options);

    if ProcessBackColor then
    begin
      TempImage.TintByAlphaToColor(BackColor);
      // Now draw the text over again, but with no glow, so only the text is drawn
      TextRect := Rect(GlowSize, GlowSize, TextSize.cx + GlowSize,
        TextSize.cy + GlowSize);
      Options.dwFlags := DTT_TEXTCOLOR or DTT_COMPOSITED;
      Options.crText := ColorToRGB(Font.Color);
      Options.iGlowSize := 0;
      DrawThemeTextEx(InternalStyleServices.Theme[teEdit], TempImage.FDCHandle,
        Details.Part, Details.State, PChar(Text), Length(Text),
        AlignFlags or DT_TOP or DT_NOCLIP, TextRect, Options);
    end;

    case Alignment of
      taLeftJustify:
        TempImage.BlendTo(ARect.Left - GlowSize, ARect.Top - GlowSize,
          FWorkingCanvas, Alpha);
      taRightJustify:
        TempImage.BlendTo(ARect.Left - GlowSize * 2, ARect.Top - GlowSize,
          FWorkingCanvas, Alpha);
      taCenter:
        TempImage.BlendTo(ARect.Left - GlowSize * 2 + 1 + IfThen(GlowSize > 0,
          1, -1), ARect.Top - GlowSize, FWorkingCanvas, Alpha);
    end;
    SetBkMode(TempImage.FDCHandle, OPAQUE);
    TempImage.SelectOriginalObjects;
  finally
    TempImage.Free;
  end;
end;

procedure TCustomTransparentCanvas.GlowTextOut(const X, Y, GlowSize: Integer;
  const Text: string; const Alignment: TAlignment; const Alpha: Byte);
begin
  InternalGlowTextOut(X, Y, GlowSize, Text, Alignment, Alpha, False,
    TQuadColor.Create(0));
end;

procedure TCustomTransparentCanvas.GlowTextOutBackColor(const X, Y,
  GlowSize: Integer; const Text: string; const BackColor: TColor;
  const Alignment: TAlignment; const GlowAlpha: Byte; const Alpha: Byte);
var
  Background: TQuadColor;
begin
  if (COLORREF(ColorToRGB(BackColor)) = RGB(255, 255, 255)) and (GlowAlpha = 255)
  then
  begin // White is the default on
    // Windows; do no special processing
    GlowTextOut(X, Y, GlowSize, Text, Alignment, Alpha);
  end
  else
  begin
    // Windows draws glowing text with a white background, always. To change the background colour,
    // draw with the normal white background and black text, then process the colours to change
    // white to the specified colour, and black to the font colour
    Background := TQuadColor.Create(BackColor);
    Background.SetAlpha(GlowAlpha, Alpha / 255.0);
    InternalGlowTextOut(X, Y, GlowSize, Text, Alignment, Alpha, True,
      Background);
  end;
end;

procedure TCustomTransparentCanvas.MoveTo(const X, Y: Integer);
begin
  MoveToEx(FWorkingCanvas.FDCHandle, X, Y, nil);
end;

function TCustomTransparentCanvas.OrphanAliasedFont: HFONT;
var
  FontWeight: Cardinal;
begin
  // Font output and alpha is tricky with a ClearType or antialiased font. This method takes FFont
  // and creates a new font with the same attributes, but with ClearType and AA explicitly disabled
  if fsBold in Font.Style then
    FontWeight := FW_BOLD
  else
    FontWeight := FW_NORMAL;
  Result := CreateFont(FFont.Height, 0, 0, 0, FontWeight,
    Cardinal(fsItalic in Font.Style), Cardinal(fsUnderline in Font.Style),
    Cardinal(fsStrikeOut in Font.Style), DEFAULT_CHARSET, OUT_DEFAULT_PRECIS,
    CLIP_DEFAULT_PRECIS, ANTIALIASED_QUALITY, DEFAULT_PITCH, PChar(Font.Name));
end;

procedure TCustomTransparentCanvas.Polygon(const Polygon: array of TPoint;
  const X1, Y1, X2, Y2: Integer; const Alpha: Byte);
var
  TempImage: TAlphaBitmapWrapper;

begin
  TempImage := TAlphaBitmapWrapper.CreateForGDI(FWorkingCanvas.FDCHandle,
    X2 - X1 + 1, Y2 - Y1 + 1);
  try

    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(Brush.Handle,
      Pen.Handle, Font.Handle));
    SetWindowOrgEx(TempImage.FDCHandle, X1 - Pen.Width div 2,
      Y1 - Pen.Width div 2, nil);
    Windows.Polygon(TempImage.FDCHandle, Polygon, Length(Polygon));
    SetWindowOrgEx(TempImage.FDCHandle, 0, 0, nil);
    TempImage.ProcessTransparency(Alpha);
    TempImage.BlendTo(X1, Y1, FWorkingCanvas);
    TempImage.SelectOriginalObjects;
  finally
    TempImage.Free;
  end;
end;

procedure TCustomTransparentCanvas.Polyline(const Polygon: array of TPoint;
  const X1, Y1, X2, Y2: Integer; const Alpha: Byte);
var
  TempImage: TAlphaBitmapWrapper;

begin
  TempImage := TAlphaBitmapWrapper.CreateForGDI(FWorkingCanvas.FDCHandle,
    X2 - X1 + 1, Y2 - Y1 + 1);
  try

    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(Brush.Handle,
      Pen.Handle, Font.Handle));
    SetWindowOrgEx(TempImage.FDCHandle, X1 - Pen.Width div 2,
      Y1 - Pen.Width div 2, nil);
    Windows.Polyline(TempImage.FDCHandle, Polygon, Length(Polygon));
    SetWindowOrgEx(TempImage.FDCHandle, 0, 0, nil);
    TempImage.ProcessTransparency(Alpha);
    TempImage.BlendTo(X1, Y1, FWorkingCanvas);
    TempImage.SelectOriginalObjects;
  finally
    TempImage.Free;
  end;
end;

procedure TCustomTransparentCanvas.LineTo(const X1, Y1, X2, Y2: Integer;
  const Alpha: Byte);
var
  TempImage: TAlphaBitmapWrapper;
  X, Y: Integer;
begin

  TempImage := TAlphaBitmapWrapper.CreateForGDI(FWorkingCanvas.FDCHandle,
    abs(X2 - X1) + Pen.Width, abs(Y2 - Y1) + Pen.Width);

  try

    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(Brush.Handle,
      Pen.Handle, Font.Handle));

    if X1 > X2 then
    begin
      X := X2;
    end
    else
    begin
      X := X1;
    end;

    if Y1 > Y2 then
    begin
      Y := Y2;
    end
    else
    begin
      Y := Y1;
    end;
    SetWindowOrgEx(TempImage.FDCHandle, X - Pen.Width div 2,
      Y - Pen.Width div 2, nil);
    Windows.MoveToEx(TempImage.FDCHandle, X1, Y1, nil);
    Windows.LineTo(TempImage.FDCHandle, X2, Y2);
    SetWindowOrgEx(TempImage.FDCHandle, 0, 0, nil);
    TempImage.ProcessTransparency(Alpha);
    TempImage.BlendTo(X, Y, FWorkingCanvas);
    TempImage.SelectOriginalObjects;
  finally
    TempImage.Free;
  end;
end;

class function TCustomTransparentCanvas.QuadColorToTColor
  (Color: TQuadColor): TColor;
begin
  Result := TColor(RGB(Color.Red, Color.Blue, Color.Green));
end;

procedure TCustomTransparentCanvas.Rectangle(const X1, Y1, X2, Y2: Integer;
  const Alpha: Byte);
var
  TempImage: TAlphaBitmapWrapper;
begin
  TempImage := TAlphaBitmapWrapper.CreateForGDI(FWorkingCanvas.FDCHandle,
    X2 - X1, Y2 - Y1);
  try
    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(Brush.Handle,
      Pen.Handle, Font.Handle));
    SetWindowOrgEx(TempImage.FDCHandle, X1 - Pen.Width div 2,
      Y1 - Pen.Width div 2, nil);
    Windows.Rectangle(TempImage.FDCHandle, X1, Y1, X2, Y2);
    SetWindowOrgEx(TempImage.FDCHandle, 0, 0, nil);
    TempImage.ProcessTransparency(Alpha);
    TempImage.BlendTo(X1, Y1, FWorkingCanvas);
    TempImage.SelectOriginalObjects;
  finally
    TempImage.Free;
  end;
end;

procedure TCustomTransparentCanvas.Rectangle(const Rect: TRect;
  const Alpha: Byte);
begin
  Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, Alpha);
end;

procedure TCustomTransparentCanvas.RoundRect(const Rect: TRect;
  const XRadius, YRadius: Integer; const Alpha: Byte = $FF);
begin
  RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, XRadius,
    YRadius, Alpha);
end;

procedure TCustomTransparentCanvas.RoundRect(const X1, Y1, X2, Y2, XRadius,
  YRadius: Integer; const Alpha: Byte = $FF);
var
  TempImage: TAlphaBitmapWrapper;
begin
  TempImage := TAlphaBitmapWrapper.CreateForGDI(FWorkingCanvas.FDCHandle,
    X2 - X1 + Pen.Width, Y2 - Y1 + Pen.Width);
  try
    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(Brush.Handle,
      Pen.Handle, Font.Handle));
    SetWindowOrgEx(TempImage.FDCHandle, X1 - Pen.Width div 2,
      Y1 - Pen.Width div 2, nil);
    Windows.RoundRect(TempImage.FDCHandle, X1, Y1, X2, Y2, XRadius, YRadius);
    SetWindowOrgEx(TempImage.FDCHandle, 0, 0, nil);
    TempImage.ProcessTransparency(Alpha);
    TempImage.BlendTo(X1, Y1, FWorkingCanvas);
    TempImage.SelectOriginalObjects;
  finally
    TempImage.Free;
  end;
end;

procedure TCustomTransparentCanvas.SetBrush(NewBrush: TBrush);
begin
  FBrush.Assign(NewBrush);
end;

procedure TCustomTransparentCanvas.SetFont(NewFont: TFont);
begin
  FFont.Assign(NewFont);
end;

procedure TCustomTransparentCanvas.SetPen(NewPen: TPen);
begin
  FPen.Assign(NewPen);
end;

procedure TCustomTransparentCanvas.SetPenPos(NewPos: TPoint);
begin
  MoveToEx(FWorkingCanvas.FDCHandle, NewPos.X, NewPos.Y, nil);
end;

procedure TCustomTransparentCanvas.SetPixel(X, Y: Integer; Color: Cardinal);
begin
  SetPixel(X, Y, Color, $FF);
end;

procedure TCustomTransparentCanvas.SetPixel(X, Y: Integer; Color: Cardinal;
  Alpha: Byte);
var
  PQuad: PQuadColor;
  InverseY: Integer;
begin
  InverseY := FWorkingCanvas.FHeight - Y - 1; // 0 is top not bottom
  PQuad := FWorkingCanvas.FQuads;
  Inc(PQuad, (InverseY * Width) + X);
  PQuad.Quad := Color;
  PQuad.Alpha := Alpha;
end;

procedure TCustomTransparentCanvas.SetRawPixel(X, Y: Integer;
  Color: TQuadColor);
var
  PQuad: PQuadColor;
  InverseY: Integer;
begin
  InverseY := FWorkingCanvas.FHeight - Y - 1; // 0 is top not bottom
  PQuad := FWorkingCanvas.FQuads;
  Inc(PQuad, (InverseY * Width) + X);
  PQuad.Quad := Color.Quad;
end;

class function TCustomTransparentCanvas.TColorToQuadColor(Color: TColor)
  : TQuadColor;
begin
  Result := TQuadColor.Create(Color);
end;

function TCustomTransparentCanvas.TextExtent(const Text: string): TSize;
var
  OldFontHandle, FontHandle: HFONT;
begin
  if Length(Text) = 0 then
  begin
    Result.cx := 0;
    Result.cy := 0;
    Exit;
  end;

  if CanUseDrawThemeTextEx then
  begin // Can use DrawThemeTextEx; just get text extent normally
    FWorkingCanvas.SelectObjects(TGDIObjects.CreateWithHandles(0, 0,
      Font.Handle));
    GetTextExtentPoint32(FWorkingCanvas.FDCHandle, PChar(Text),
      Length(Text), Result);
    FWorkingCanvas.SelectOriginalObjects;
  end
  else
  begin
    // Can't use DrawThemeTextEx; use aliased font (may affect output size, so need to explicitly
    // measure using the aliased font)
    FontHandle := OrphanAliasedFont;
    try
      OldFontHandle := SelectObject(FWorkingCanvas.FDCHandle, FontHandle);
      GetTextExtentPoint32(FWorkingCanvas.FDCHandle, PChar(Text),
        Length(Text), Result);
      SelectObject(FWorkingCanvas.FDCHandle, OldFontHandle);
    finally
      DeleteObject(FontHandle);
    end;
  end;
end;

function TCustomTransparentCanvas.TextHeight(const Text: string): Integer;
begin
  Result := TextExtent(Text).cy;
end;

procedure TCustomTransparentCanvas.TextOut(const X, Y: Integer;
  const Text: string; const Alignment: TAlignment; const Alpha: Byte);
var
  TextSize: TSize;
begin
  if Length(Text) = 0 then
    Exit; // Crash creating zero-sized bitmap

  TextSize := TextExtent(Text);
  if CanUseDrawThemeTextEx then
    TextOutVistaPlus(Rect(X, Y, X + TextSize.cx, Y + TextSize.cy), Text,
      Alignment, Alpha)
  else
    TextOutPreVista(Rect(X, Y, X + TextSize.cx, Y + TextSize.cy), Text,
      Alignment, Alpha);
end;

procedure TCustomTransparentCanvas.TextOutPreVista(const Rect: TRect;
  const Text: string; const Alignment: TAlignment; const Alpha: Byte);
var
  TempImage: TAlphaBitmapWrapper;
  FontHandle: HFONT;
  TextSize: TSize;
  OldAlign: UINT;
begin
  if Length(Text) = 0 then
    Exit; // Crash creating zero-sized bitmap

  TextSize := TextExtent(Text);
  // Clip to the rest by restricting the size it thinks the text is - the bitmap will be this size, thus clipped
  TextSize.cx := min(TextSize.cx, Rect.Right - Rect.Left);
  TextSize.cy := min(TextSize.cy, Rect.Bottom - Rect.Top);
  FontHandle := OrphanAliasedFont;
  // Antialiased or cleartype text works terribly when trying to fix the alpha
  TempImage := TAlphaBitmapWrapper.CreateForGDI(FWorkingCanvas.FDCHandle,
    TextSize.cx, TextSize.cy);
  try
    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(0, 0, FontHandle));
    SetBkMode(TempImage.FDCHandle, TRANSPARENT);
    SetTextColor(TempImage.FDCHandle, ColorToRGB(Font.Color));
    OldAlign := GetTextAlign(TempImage.FDCHandle);
    try
      case Alignment of
        taLeftJustify:
          SetTextAlign(TempImage.FDCHandle, TA_LEFT);
        taRightJustify:
          SetTextAlign(TempImage.FDCHandle, TA_RIGHT);
        taCenter:
          SetTextAlign(TempImage.FDCHandle, TA_CENTER);
      end;
      ExtTextOut(TempImage.FDCHandle, 0, 0, ETO_CLIPPED, nil, PChar(Text),
        Length(Text), nil);
    finally
      SetTextAlign(TempImage.FDCHandle, OldAlign);
    end;
    SetBkMode(TempImage.FDCHandle, OPAQUE);
    TempImage.ProcessTransparency(Alpha);
    TempImage.BlendTo(Rect.Left, Rect.Top, FWorkingCanvas);
    TempImage.SelectOriginalObjects;
  finally
    DeleteObject(FontHandle);
    TempImage.Free;
  end;
end;

procedure TCustomTransparentCanvas.TextOutVistaPlus(const ARect: TRect;
  const Text: string; const Alignment: TAlignment; const Alpha: Byte);
var
  TempImage: TAlphaBitmapWrapper;
  TextSize: TSize;
  Options: TDTTOpts;
  Details: TThemedElementDetails;
  TextRect: TRect;
  AlignFlags: DWORD;
begin
  if Length(Text) = 0 then
    Exit; // Crash creating zero-sized bitmap
  if not CanUseDrawThemeTextEx then
    raise ETransparentCanvasException.Create('Cannot use DrawThemeTextEx');

  AlignFlags := AlignmentToFlags(Alignment);
  TextSize := ARect.Size; // TextExtent(Text);
  // Clip by clipping the size of the rectangle it assumes the text fits in
  TextSize.cx := min(TextSize.cx, ARect.Right - ARect.Left);
  TextSize.cy := min(TextSize.cy, ARect.Bottom - ARect.Top);
  TempImage := TAlphaBitmapWrapper.CreateForDrawThemeTextEx
    (FWorkingCanvas.FDCHandle, TextSize.cx, TextSize.cy);
  try
    TempImage.SelectObjects(TGDIObjects.CreateWithHandles(0, 0, Font.Handle));
    SetBkMode(TempImage.FDCHandle, TRANSPARENT);
    SetTextColor(TempImage.FDCHandle, ColorToRGB(Font.Color));

    ZeroMemory(@Options, SizeOf(Options));
    Options.dwSize := SizeOf(Options);
    Options.dwFlags := DTT_TEXTCOLOR or DTT_COMPOSITED;
    Options.crText := ColorToRGB(Font.Color);
    Options.iGlowSize := 0;

    Details := InternalStyleServices.GetElementDetails(teEditTextNormal);
    TextRect := Rect(0, 0, TextSize.cx, TextSize.cy);
    DrawThemeTextEx(InternalStyleServices.Theme[teEdit], TempImage.FDCHandle,
      Details.Part, Details.State, PChar(Text), Length(Text),
      AlignFlags or DT_TOP, TextRect, Options);

    SetBkMode(TempImage.FDCHandle, OPAQUE);
    TempImage.BlendTo(ARect.Left, ARect.Top, FWorkingCanvas, Alpha);
    TempImage.SelectOriginalObjects;
  finally
    TempImage.Free;
  end;
end;

procedure TCustomTransparentCanvas.TextRect(const Rect: TRect;
  const Text: string; const Alignment: TAlignment; const Alpha: Byte);
begin
  if Length(Text) = 0 then
    Exit; // Crash creating zero-sized bitmap

  if CanUseDrawThemeTextEx then
    TextOutVistaPlus(Rect, Text, Alignment, Alpha)
  else
    TextOutPreVista(Rect, Text, Alignment, Alpha);
end;

function TCustomTransparentCanvas.TextWidth(const Text: string): Integer;
begin
  Result := TextExtent(Text).cx;
end;

{ TAlphaBitmapWrapper }

procedure TAlphaBitmapWrapper.BlendTo(X, Y: Integer;
  var Image: TAlphaBitmapWrapper; Transparency: Byte);
var
  BlendFunc: TBlendFunction;
begin
  with BlendFunc do
  begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    SourceConstantAlpha := Transparency; // Normally 255
    AlphaFormat := AC_SRC_ALPHA;
  end;
  AlphaBlend(Image.FDCHandle, X, Y, FWidth, FHeight, FDCHandle, 0, 0, FWidth,
    FHeight, BlendFunc);
end;

procedure TAlphaBitmapWrapper.BlendToDC(X, Y: Integer; DC: HDC;
  Transparency: Byte);
var
  BlendFunc: TBlendFunction;
begin
  with BlendFunc do
  begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    SourceConstantAlpha := Transparency;
    AlphaFormat := AC_SRC_ALPHA;
  end;
  AlphaBlend(DC, X, Y, FWidth, FHeight, FDCHandle, 0, 0, FWidth, FHeight,
    BlendFunc);
end;

procedure TAlphaBitmapWrapper.BlendToStretch(X, Y, StretchWidth,
  StretchHeight: Integer; var Image: TAlphaBitmapWrapper; Transparency: Byte);
var
  BlendFunc: TBlendFunction;
begin
  with BlendFunc do
  begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    SourceConstantAlpha := Transparency; // Normally 255
    AlphaFormat := AC_SRC_ALPHA;
  end;
  AlphaBlend(Image.FDCHandle, 0, 0, StretchWidth, StretchHeight, FDCHandle, X,
    Y, FWidth, FHeight, BlendFunc);
end;

procedure TAlphaBitmapWrapper.CheckHandles;
begin
  if FDCHandle = 0 then
    raise ETransparentCanvasException.Create('Cannot create device context');
  if FBMPHandle = 0 then
    raise ETransparentCanvasException.Create('Cannot create 32-bit bitmap');
  if FQuads = nil then
    raise ETransparentCanvasException.Create('Cannot access bitmap bits');
end;

procedure TAlphaBitmapWrapper.Clear;
begin
  ZeroMemory(FQuads, FWidth * FHeight * SizeOf(TQuadColor));
end;

procedure TAlphaBitmapWrapper.Construct(DC: HDC; Empty: Boolean;
  Width, Height: Integer; Inverted: Boolean);
var
  BMPInfo: TBitmapInfo;
  PQuads: Pointer;
begin
  FWidth := Width;
  FHeight := Height;
  if (FWidth <= 0) or (FHeight <= 0) then
    raise ETransparentCanvasException.Create
      ('Invalid size specified; Width and Height must both be greater than zero.');
  FDCHandle := CreateCompatibleDC(DC);
  ZeroMemory(@BMPInfo, SizeOf(TBitmapInfo));
  with BMPInfo.bmiHeader do
  begin
    biSize := SizeOf(TBitmapInfo);
    biWidth := FWidth;
    if Inverted then
    begin
      biHeight := -FHeight
      // For DrawThemeTextEx: requires inverted (bottom-up) bitmap
    end
    else
    begin
      biHeight := FHeight;
    end;
    biPlanes := 1;
    biBitCount := 32;
    biCompression := BI_RGB;
    biSizeImage := FWidth * FHeight * SizeOf(TQuadColor);
  end;
  PQuads := nil;
  FBMPHandle := 0;
  FBMPHandle := CreateDIBSection(FDCHandle, BMPInfo, DIB_RGB_COLORS,
    PQuads, 0, 0);
  FQuads := PQuadColor(PQuads);
  CheckHandles;
  FOriginalBMP := SelectObject(FDCHandle, FBMPHandle);
  GdiFlush; // Need to flush before any manipulation of bits
  if Empty then
  begin
    ZeroMemory(FQuads, Width * Height * SizeOf(TQuadColor));
  end
  else
  begin
    FillMemory(FQuads, Width * Height * SizeOf(TQuadColor), $FF);
  end;
end;

constructor TAlphaBitmapWrapper.Create(var ToCopy: TAlphaBitmapWrapper);
begin
  inherited Create();
  Construct(ToCopy.FDCHandle, True, ToCopy.FWidth, ToCopy.FHeight);
  // true = init to all zeroes
  ToCopy.BlendTo(0, 0, Self);
end;

constructor TAlphaBitmapWrapper.CreateBlank(DC: HDC; Width, Height: Integer);
begin
  inherited Create();
  Construct(DC, True, Width, Height); // true = init to all zeroes
end;

constructor TAlphaBitmapWrapper.CreateForDrawThemeTextEx(DC: HDC;
  Width, Height: Integer; DummyDrawThemeTextEx: SmallInt = 0);
begin
  inherited Create();
  Construct(DC, True, Width, Height, True);
  // init to all zeroes; inverted (upside down) because DrawThemeTextEx needs it
end;

constructor TAlphaBitmapWrapper.CreateForGDI(DC: HDC; Width, Height: Integer;
  DummyGDI: Byte = 0);
begin
  inherited Create();
  Construct(DC, False, Width, Height);
  // false = init all bytes to $FF, so can test if written to
end;

destructor TAlphaBitmapWrapper.Destroy;
begin
  SelectOriginalObjects;
  SelectObject(FDCHandle, FOriginalBMP);
  DeleteObject(FBMPHandle);
  FBMPHandle := 0;
  DeleteObject(FDCHandle);
  FDCHandle := 0;
  inherited;
end;

procedure TAlphaBitmapWrapper.TintByAlphaToColor(const Color: TQuadColor);
var
  Loop: Integer;
  PQuad: PQuadColor;
begin
  // Change the background colour of glowing text by changing white to BackColor, and black to
  // TextColor. Alpha remains the same
  GdiFlush; // Need to flush before any manipulation of bits
  PQuad := FQuads;
  for Loop := 0 to FWidth * FHeight - 1 do
  begin
    if PQuad.Alpha <> 0 then
    begin
      PQuad.SetFromColorMultAlpha(Color);
      // Sets the colour, and multiplies the alphas together
    end;
    Inc(PQuad);
  end;
end;

procedure TAlphaBitmapWrapper.ProcessMaskTransparency(var MaskImage
  : TAlphaBitmapWrapper);
var
  Loop: Integer;
  PQuad, PMaskQuad: PQuadColor;
begin
  if not((FWidth = MaskImage.FWidth)) and (FHeight = MaskImage.FHeight) then
    raise ETransparentCanvasException.Create
      ('Mask images must be identical in size');

  GdiFlush; // Need to flush before any manipulation of bits
  PQuad := FQuads;
  PMaskQuad := MaskImage.FQuads;
  for Loop := 0 to FWidth * FHeight - 1 do
  begin
    if (PMaskQuad.Quad and $00FFFFFF) = 0 then
    begin
      PQuad.SetAlpha(255, 1.0);
    end
    else
    begin
      PQuad.Quad := 0;
    end;
    Inc(PQuad);
    Inc(PMaskQuad);
  end;
end;

procedure TAlphaBitmapWrapper.ProcessTransparentColor(const TransparentColor
  : COLORREF; const TransparentEdgeWidth: Integer);
  function IsEdge(const PixelIndex: Integer): Boolean;
  var
    X, Y: Integer;
  begin
    if TransparentEdgeWidth < 0 then
      Exit(True); // Entire image should be processed
    // index = (Y * width) + X (note Y is inverse)
    Y := PixelIndex div FWidth;
    X := PixelIndex - (Y * FWidth);
    Result := (X < TransparentEdgeWidth) or (Y < TransparentEdgeWidth) or
      (X > (FWidth - TransparentEdgeWidth - 1)) or
      (Y > (FHeight - TransparentEdgeWidth - 1));
  end;

var
  Loop: Integer;
  PQuad: PQuadColor;
  R, G, B: Byte;
begin
  if TransparentEdgeWidth = 0 then
    Exit; // Want to process an edge, but no edge width (pass -1 for whole image)

  GdiFlush; // Need to flush before any manipulation of bits
  R := GetRValue(TransparentColor);
  G := GetGValue(TransparentColor);
  B := GetBValue(TransparentColor);
  PQuad := FQuads;
  for Loop := 0 to FWidth * FHeight - 1 do
  begin
    if (PQuad.Red = R) and (PQuad.Green = G) and (PQuad.Blue = B) and
      IsEdge(Loop) then
    begin
      PQuad.SetAlpha(0, 0);
      // 32-bit OSes must have all channels 0 (premultiplied) for 0 alpha
    end;
    Inc(PQuad);
  end;
end;

procedure TAlphaBitmapWrapper.ProcessTransparency(const Alpha: Byte;
  TranspRect: TRect);
var
  LoopX: Integer;
  PreMult: Single;
  PQuad: PQuadColor;
  LoopY: Integer;
begin
  GdiFlush; // Need to flush before any manipulation of bits
  IntersectRect(TranspRect, TranspRect, Rect(0, 0, FWidth, FHeight));
  // Clip to valid bounds

  PreMult := Alpha / 255.0;
  for LoopY := TranspRect.Top to TranspRect.Bottom - 1 do
  begin
    PQuad := FQuads;
    Inc(PQuad, LoopY);
    for LoopX := TranspRect.Left to TranspRect.Right - 1 do
    begin
      if PQuad.WrittenByGDI then
      begin
        PQuad.SetAlpha(Alpha, PreMult);
      end
      else
      begin
        PQuad.Quad := 0;
      end;
      Inc(PQuad);
    end;
  end;
end;

procedure TAlphaBitmapWrapper.ProcessTransparency(const Alpha: Byte);
var
  Loop: Integer;
  PreMult: Single;
  PQuad: PQuadColor;
begin
  GdiFlush; // Need to flush before any manipulation of bits
  PreMult := Alpha / 255.0;
  PQuad := FQuads;
  for Loop := 0 to FWidth * FHeight - 1 do
  begin
    if PQuad.WrittenByGDI then
    begin
      PQuad.SetAlpha(Alpha, PreMult);
    end
    else
    begin
      PQuad.Quad := 0;
    end;
    Inc(PQuad);
  end;
end;

function TAlphaBitmapWrapper.QuadPointer: PQuadColor;
begin
  Result := FQuads;
end;

function TAlphaBitmapWrapper.GetRawPixelPtr(const X, Y: Integer): PQuadColor;
var
  PQuad: PQuadColor;
  InverseY: Integer;
begin
  if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
  begin
    InverseY := FHeight - Y - 1; // 0 is top not bottom
    PQuad := FQuads;
    Inc(PQuad, (InverseY * FWidth) + X);
    Result := PQuad;
  end
  else
  begin
    Result := nil;
  end;
end;

procedure TAlphaBitmapWrapper.SafeSetRawPixel(const X, Y: Integer;
  Color: TQuadColor);
var
  PQuad: PQuadColor;
  InverseY: Integer;
begin
  if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
  begin
    InverseY := FHeight - Y - 1; // 0 is top not bottom
    PQuad := FQuads;
    Inc(PQuad, (InverseY * FWidth) + X);
    PQuad.Quad := Color.Quad;
  end;
end;

procedure TAlphaBitmapWrapper.SelectObjects(const GDI: TGDIObjects);
begin
  // This is only one layer deep - it stores the old objects in FOriginalObjects
  // If you call if more than once, it will overwrite the values in FOriginalObjects
  // If you find yourself doing this, this needs to be rewritten as a stack, and you'd
  // push and pop the handles.
  if (FOriginalObjects.FBrush <> 0) or (FOriginalObjects.FPen <> 0) or
    (FOriginalObjects.FFont <> 0) then
    raise ETransparentCanvasException.Create
      ('SelectObjects has already been called');

  FOriginalObjects.FBrush := SelectObject(FDCHandle, GDI.Brush);
  FOriginalObjects.FPen := SelectObject(FDCHandle, GDI.Pen);
  FOriginalObjects.FFont := SelectObject(FDCHandle, GDI.Font);
end;

procedure TAlphaBitmapWrapper.SelectOriginalObjects;
begin
  SelectObject(FDCHandle, FOriginalObjects.FBrush);
  FOriginalObjects.FBrush := 0;
  SelectObject(FDCHandle, FOriginalObjects.FPen);
  FOriginalObjects.FPen := 0;
  SelectObject(FDCHandle, FOriginalObjects.FFont);
  FOriginalObjects.FFont := 0;
end;

procedure TAlphaBitmapWrapper.SetAllTransparency(const Alpha: Byte);
var
  Loop: Integer;
  PreMult: Single;
  PQuad: PQuadColor;
begin
  GdiFlush; // Need to flush before any manipulation of bits
  PreMult := Alpha / 255.0;
  PQuad := FQuads;
  for Loop := 0 to FWidth * FHeight - 1 do
  begin
    PQuad.SetAlpha(Alpha, PreMult);
    Inc(PQuad);
  end;
end;

{ TQuadColor }

function TQuadColor.AsColorRef: COLORREF;
var
  PreDiv: Single;
begin
  // contains premultiplied alpha, so un-premultiply it and return that
  if Alpha = 0 then
  begin
    Result := $00000000;
  end
  else
  begin
    PreDiv := 1 / (Alpha / 255.0);
    Result := RGB(Trunc(Red * PreDiv), Trunc(Green * PreDiv),
      Trunc(Blue * PreDiv)) or (Alpha shl 24);
  end;
end;

procedure TQuadColor.Clear;
begin
  Quad := 0;
end;

constructor TQuadColor.Create(Color: TColor);
var
  ColorRGB: COLORREF;
begin
  Alpha := 255;
  ColorRGB := ColorToRGB(Color);
  Red := GetRValue(ColorRGB);
  Green := GetGValue(ColorRGB);
  Blue := GetBValue(ColorRGB);
end;

procedure TQuadColor.SetAlpha(const Transparency: Byte; const PreMult: Single);
begin
  Alpha := Transparency;
  Blue := Trunc(Blue * PreMult);
  Green := Trunc(Green * PreMult);
  Red := Trunc(Red * PreMult);
end;

procedure TQuadColor.SetFromColorRef(const Color: COLORREF);
begin
  // Sets the colour, but keeps the current alpha
  if Alpha = 0 then
  begin
    Quad := 0;
  end
  else
  begin
    Red := GetRValue(Color);
    Green := GetGValue(Color);
    Blue := GetBValue(Color);
    SetAlpha(Alpha, Alpha / 255.0);
  end;
end;

procedure TQuadColor.SetFromColorMultAlpha(const Color: TQuadColor);
var
  MultAlpha: Byte;
begin
  Red := Color.Red;
  Green := Color.Green;
  Blue := Color.Blue;
  MultAlpha := Round(Integer(Alpha) * Integer(Color.Alpha) / 255.0);
  SetAlpha(MultAlpha, MultAlpha / 255.0);
end;

function TQuadColor.WrittenByGDI: Boolean;
begin
  Result := (Alpha = 0);
end;

{ TTransparentControlCanvas }

constructor TTransparentControlCanvas.Create(Control: TWinControl);
begin
  if Control = nil then
    raise ETransparentCanvasException.Create('Control must not be nil');
  if Control.Handle = 0 then
    raise ETransparentCanvasException.Create('Cannot access control handle');

  FControl := Control;
  FControlDC := GetWindowDC(Control.Handle);
  if FControlDC = 0 then
    raise ETransparentCanvasException.Create
      ('Cannot obtain control device context');

  inherited Create(FControlDC, Control.Width, Control.Height);
end;

destructor TTransparentControlCanvas.Destroy;
begin
  DrawTo(0, 0, FControlDC, FControl.Width, FControl.Height);

  ReleaseDC(FControl.Handle, FControlDC);
  FControlDC := 0;
  FWorkingCanvas.FDCHandle := 0;

  inherited;
end;

{ TGDIObjects }

constructor TGDIObjects.CreateWithHandles(const HBRUSH: HBRUSH;
  const HPEN: HPEN; const HFONT: HFONT);
begin
  FBrush := HBRUSH;
  FPen := HPEN;
  FFont := HFONT;
end;

end.