lazarus-ccr/components/spktoolbar/SpkGUITools/SpkGUITools.pas

unit SpkGUITools;

{$mode ObjFpc}
{$H+}
{$DEFINE SPKGUITOOLS}
{.$define EnhancedRecordSupport}
//the fpcbugworkaround is only necessary when using inline for DrawRoundRect
{.$define FpcBugWorkAround}

interface

{$MESSAGE HINT 'Every rect in this module are exact rectanges (not like in WINAPI without right and bottom)'}

uses
  LCLType, LCLVersion, Graphics, SysUtils, Classes, Controls, StdCtrls,
  SpkGraphTools, SpkMath;

type
  TCornerPos = (cpLeftTop, cpRightTop, cpLeftBottom, cpRightBottom);
  TCornerKind = (cpRound, cpNormal);
  TBackgroundKind = (bkSolid, bkVerticalGradient, bkHorizontalGradient,
                    bkConcave);

  TSpkButtonState = (bsIdle,
    bsBtnHottrack, bsBtnPressed, bsDropdownHottrack, bsDropdownPressed);

  TSpkCheckboxStyle = (cbsCheckbox, cbsRadioButton);
//  TSpkCheckboxState = (cbsIdle, cbsHotTrack, cbsPressed, cbsDisabled);

  TGUITools = class(TObject)
  protected
    class procedure FillGradientRectangle(ACanvas: TCanvas; Rect: T2DIntRect;
      ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind);
    class procedure SaveClipRgn(DC: HDC; out OrgRgnExists: boolean; out OrgRgn: HRGN);
    class procedure RestoreClipRgn(DC: HDC; OrgRgnExists: boolean; var OrgRgn: HRGN);
  public
    // *** Lines ***

    // Performance:
    // w/ClipRect:  Bitmap is faster (2x)
    // wo/ClipRect: Canvas is faster (a little)
    class procedure DrawHLine(ABitmap : TBitmap;
                             x1, x2 : integer;
                             y : integer;
                             Color : TColor); overload;
    class procedure DrawHLine(ABitmap : TBitmap;
                             x1, x2 : integer;
                             y : integer;
                             Color : TColor;
                             ClipRect : T2DIntRect); overload;
    class procedure DrawHLine(ACanvas : TCanvas;
                             x1, x2 : integer;
                             y : integer;
                             Color : TColor); overload;
    class procedure DrawHLine(ACanvas : TCanvas;
                             x1, x2 : integer;
                             y : integer;
                             Color : TColor;
                             ClipRect : T2DIntRect); overload;


    // Performance:
    // w/ClipRect:  Bitmap is faster (2x)
    // wo/ClipRect: Canvas is faster (a little)
    class procedure DrawVLine(ABitmap : TBitmap;
                             x : integer;
                             y1, y2 : integer;
                             Color : TColor); overload;
    class procedure DrawVLine(ABitmap : TBitmap;
                             x : integer;
                             y1, y2 : integer;
                             Color : TColor;
                             ClipRect : T2DIntRect); overload;
    class procedure DrawVLine(ACanvas : TCanvas;
                             x : integer;
                             y1, y2 : integer;
                             Color : TColor); overload;
    class procedure DrawVLine(ACanvas : TCanvas;
                             x : integer;
                             y1, y2 : integer;
                             Color : TColor;
                             ClipRect : T2DIntRect); overload;

    // *** Background and frame tools ***

    // Performance:
    // w/ClipRect:  Bitmap is faster (extremely)
    // wo/ClipRect: Bitmap is faster (extremely)
    class procedure DrawAARoundCorner(ABitmap : TBitmap;
                                     Point : T2DIntVector;
                                     Radius : integer;
                                     CornerPos : TCornerPos;
                                     Color : TColor); overload;
    class procedure DrawAARoundCorner(ABitmap : TBitmap;
                                     Point : T2DIntVector;
                                     Radius : integer;
                                     CornerPos : TCornerPos;
                                     Color : TColor;
                                     ClipRect : T2DIntRect); overload;
    class procedure DrawAARoundCorner(ACanvas : TCanvas;
                                     Point : T2DIntVector;
                                     Radius : integer;
                                     CornerPos : TCornerPos;
                                     Color : TColor); overload;
    class procedure DrawAARoundCorner(ACanvas : TCanvas;
                                     Point : T2DIntVector;
                                     Radius : integer;
                                     CornerPos : TCornerPos;
                                     Color : TColor;
                                     ClipRect : T2DIntRect); overload;

    // Performance:
    // w/ClipRect:  Bitmap is faster (extremely)
    // wo/ClipRect: Bitmap is faster (extremely)
    class procedure DrawAARoundFrame(ABitmap : TBitmap;
                                    Rect : T2DIntRect;
                                    Radius : integer;
                                    Color : TColor); overload;
    class procedure DrawAARoundFrame(ABitmap : TBitmap;
                                    Rect : T2DIntRect;
                                    Radius : integer;
                                    Color : TColor;
                                    ClipRect : T2DIntRect); overload;
    class procedure DrawAARoundFrame(ACanvas : TCanvas;
                                    Rect : T2DIntRect;
                                    Radius : integer;
                                    Color : TColor); overload;
    class procedure DrawAARoundFrame(ACanvas : TCanvas;
                                    Rect : T2DIntRect;
                                    Radius : integer;
                                    Color : TColor;
                                    ClipRect : T2DIntRect); overload;

    class procedure RenderBackground(ABuffer : TBitmap;
                                    Rect : T2DIntRect;
                                    Color1, Color2 : TColor;
                                    BackgroundKind : TBackgroundKind);

    class procedure CopyRoundCorner(ABuffer : TBitmap;
                                   ABitmap : TBitmap;
                                   SrcPoint : T2DIntVector;
                                   DstPoint : T2DIntVector;
                                   Radius : integer;
                                   CornerPos : TCornerPos;
                                   Convex : boolean = true); overload;
    class procedure CopyRoundCorner(ABuffer : TBitmap;
                                   ABitmap : TBitmap;
                                   SrcPoint : T2DIntVector;
                                   DstPoint : T2DIntVector;
                                   Radius : integer;
                                   CornerPos : TCornerPos;
                                   ClipRect : T2DIntRect;
                                   Convex : boolean = true); overload;

    class procedure CopyCorner(ABuffer : TBitmap;
                              ABitmap: TBitmap;
                              SrcPoint : T2DIntVector;
                              DstPoint: T2DIntVector;
                              Radius: integer); overload; inline;
    class procedure CopyCorner(ABuffer : TBitmap;
                              ABitmap: TBitmap;
                              SrcPoint : T2DIntVector;
                              DstPoint: T2DIntVector;
                              Radius: integer;
                              ClipRect : T2DIntRect); overload; inline;

    class procedure CopyRectangle(ABuffer : TBitmap;
                                 ABitmap: TBitmap;
                                 SrcPoint : T2DIntVector;
                                 DstPoint: T2DIntVector;
                                 Width: integer;
                                 Height : integer); overload;
    class procedure CopyRectangle(ABuffer : TBitmap;
                                 ABitmap : TBitmap;
                                 SrcPoint : T2DIntVector;
                                 DstPoint : T2DIntVector;
                                 Width : integer;
                                 Height : integer;
                                 ClipRect : T2DIntRect); overload;
    class procedure CopyMaskRectangle(ABuffer : TBitmap;
                                     AMask : TBitmap;
                                     ABitmap : TBitmap;
                                     SrcPoint : T2DIntVector;
                                     DstPoint : T2DIntVector;
                                     Width : integer;
                                     Height : integer); overload;
    class procedure CopyMaskRectangle(ABuffer : TBitmap;
                                     AMask : TBitmap;
                                     ABitmap : TBitmap;
                                     SrcPoint : T2DIntVector;
                                     DstPoint : T2DIntVector;
                                     Width : integer;
                                     Height : integer;
                                     ClipRect : T2DIntRect); overload;

    // Performance (RenderBackground + CopyRoundRect vs DrawRoundRect):
    // w/ClipRect  : Bitmap faster for smaller radiuses, Canvas faster for larger
    // wo/ClipRect : Bitmap faster for smaller radiuses, Canvas faster for larger
    class procedure CopyRoundRect(ABuffer : TBitmap;
                                 ABitmap : TBitmap;
                                 SrcPoint : T2DIntVector;
                                 DstPoint : T2DIntVector;
                                 Width, Height : integer;
                                 Radius : integer;
                                 LeftTopRound : boolean = true;
                                 RightTopRound : boolean = true;
                                 LeftBottomRound : boolean = true;
                                 RightBottomRound : boolean = true); overload;
    class procedure CopyRoundRect(ABuffer : TBitmap;
                                 ABitmap : TBitmap;
                                 SrcPoint : T2DIntVector;
                                 DstPoint : T2DIntVector;
                                 Width, Height : integer;
                                 Radius : integer;
                                 ClipRect : T2DIntRect;
                                 LeftTopRound : boolean = true;
                                 RightTopRound : boolean = true;
                                 LeftBottomRound : boolean = true;
                                 RightBottomRound : boolean = true); overload;


    class procedure DrawRoundRect(ACanvas : TCanvas;
                                 Rect : T2DIntRect;
                                 Radius : integer;
                                 ColorFrom : TColor;
                                 ColorTo : TColor;
                                 GradientKind : TBackgroundKind;
                                 LeftTopRound : boolean = true;
                                 RightTopRound : boolean = true;
                                 LeftBottomRound : boolean = true;
                                 RightBottomRound : boolean = true); overload;
    class procedure DrawRoundRect(ACanvas : TCanvas;
                                 Rect : T2DIntRect;
                                 Radius : integer;
                                 ColorFrom : TColor;
                                 ColorTo : TColor;
                                 GradientKind : TBackgroundKind;
                                 ClipRect : T2DIntRect;
                                 LeftTopRound : boolean = true;
                                 RightTopRound : boolean = true;
                                 LeftBottomRound : boolean = true;
                                 RightBottomRound : boolean = true); overload;

    class procedure DrawRegion(ACanvas : TCanvas;
                              Region : HRGN;
                              Rect : T2DIntRect;
                              ColorFrom : TColor;
                              ColorTo : TColor;
                              GradientKind : TBackgroundKind); overload;
    class procedure DrawRegion(ACanvas : TCanvas;
                              Region : HRGN;
                              Rect : T2DIntRect;
                              ColorFrom : TColor;
                              ColorTo : TColor;
                              GradientKind : TBackgroundKind;
                              ClipRect : T2DIntRect); overload;

    // Imagelist tools
    class procedure DrawImage(ABitmap : TBitmap;
                             Imagelist : TImageList;
                             ImageIndex : integer;
                             Point : T2DIntVector); overload; inline;
    class procedure DrawImage(ABitmap : TBitmap;
                             Imagelist : TImageList;
                             ImageIndex : integer;
                             Point : T2DIntVector;
                             ClipRect : T2DIntRect); overload; inline;
    class procedure DrawImage(ACanvas : TCanvas;
                             Imagelist : TImageList;
                             ImageIndex : integer;
                             Point : T2DIntVector); overload; inline;
    class procedure DrawImage(ACanvas : TCanvas;
                             Imagelist : TImageList;
                             ImageIndex : integer;
                             Point : T2DIntVector;
                             ClipRect : T2DIntRect); overload;
    class procedure DrawImage(ACanvas: TCanvas;
                             Imagelist: TImageList;
                             ImageIndex: integer;
                             Point : T2DIntVector;
                             ClipRect: T2DIntRect;
                             AImageWidthAt96PPI, ATargetPPI: Integer;
                             ACanvasFactor: Double); overload;

    class procedure DrawDisabledImage(ABitmap : TBitmap;
                                     Imagelist : TImageList;
                                     ImageIndex : integer;
                                     Point : T2DIntVector); overload; inline;
    class procedure DrawDisabledImage(ABitmap : TBitmap;
                                     Imagelist : TImageList;
                                     ImageIndex : integer;
                                     Point : T2DIntVector;
                                     ClipRect : T2DIntRect); overload; inline;
    class procedure DrawDisabledImage(ACanvas : TCanvas;
                                     Imagelist : TImageList;
                                     ImageIndex : integer;
                                     Point : T2DIntVector); overload;
    class procedure DrawDisabledImage(ACanvas : TCanvas;
                                     Imagelist : TImageList;
                                     ImageIndex : integer;
                                     Point : T2DIntVector;
                                     ClipRect : T2DIntRect); overload; inline;

    // Checkbox
    class procedure DrawCheckbox(ACanvas: TCanvas;
                                 x,y: Integer;
                                 AState: TCheckboxState;
                                 AButtonState: TSpkButtonState;
                                 AStyle: TSpkCheckboxStyle); overload;
    class procedure DrawCheckbox(ACanvas: TCanvas;
                                 x,y: Integer;
                                 AState: TCheckboxState;
                                 AButtonState: TSpkButtonState;
                                 AStyle: TSpkCheckboxStyle;
                                 ClipRect: T2DIntRect); overload;

    // Text tools
    class procedure DrawText(ABitmap : TBitmap;
                        x, y : integer;
                        const AText : string;
                        TextColor: TColor); overload;
    class procedure DrawText(ABitmap : TBitmap;
                        x, y : integer;
                        const AText : string;
                        TextColor : TColor;
                        ClipRect: T2DIntRect); overload;
    class procedure DrawMarkedText(ACanvas : TCanvas;
                                  x, y : integer;
                                  const AText, AMarkPhrase : string;
                                  TextColor : TColor;
                                  CaseSensitive : boolean = false); overload;
    class procedure DrawMarkedText(ACanvas : TCanvas;
                                  x, y : integer;
                                  const AText, AMarkPhrase : string;
                                  TextColor : TColor;
                                  ClipRect : T2DIntRect;
                                  CaseSensitive : boolean = false); overload;
    class procedure DrawText(ACanvas : TCanvas;
                        x, y : integer;
                        const AText : string;
                        TextColor : TColor); overload;
    class procedure DrawText(ACanvas : TCanvas;
                        x, y : integer;
                        const AText : string;
                        TextColor : TColor;
                        ClipRect : T2DIntRect); overload;
    class procedure DrawFitWText(ABitmap : TBitmap;
                                x1, x2 : integer;
                                y : integer;
                                const AText : string;
                                TextColor : TColor;
                                Align : TAlignment); overload;
    class procedure DrawFitWText(ACanvas : TCanvas;
                                x1, x2 : integer;
                                y : integer;
                                const AText : string;
                                TextColor : TColor;
                                Align : TAlignment); overload;

    class procedure DrawOutlinedText(ABitmap : TBitmap;
                                    x, y : integer;
                                    const AText : string;
                                    TextColor : TColor;
                                    OutlineColor : TColor); overload;
    class procedure DrawOutlinedText(ABitmap : TBitmap;
                                    x, y : integer;
                                    const AText : string;
                                    TextColor : TColor;
                                    OutlineColor : TColor;
                                    ClipRect : T2DIntRect); overload;
    class procedure DrawOutlinedText(ACanvas : TCanvas;
                                    x, y : integer;
                                    const AText : string;
                                    TextColor : TColor;
                                    OutlineColor : TColor); overload;
    class procedure DrawOutlinedText(ACanvas : TCanvas;
                                    x, y : integer;
                                    const AText : string;
                                    TextColor : TColor;
                                    OutlineColor : TColor;
                                    ClipRect : T2DIntRect); overload;
    class procedure DrawFitWOutlinedText(ABitmap: TBitmap;
                                        x1, x2 : integer;
                                        y: integer;
                                        const AText: string;
                                        TextColor,
                                        OutlineColor: TColor;
                                        Align: TAlignment); overload;
    class procedure DrawFitWOutlinedText(ACanvas: TCanvas;
                                        x1, x2 : integer;
                                        y: integer;
                                        const AText: string;
                                        TextColor,
                                        OutlineColor: TColor;
                                        Align: TAlignment); overload;
end;

implementation

uses
  Types, LCLIntf, IntfGraphics, Themes;

{ TSpkGUITools }

class procedure TGUITools.CopyRoundCorner(ABuffer, ABitmap: TBitmap; SrcPoint,
  DstPoint: T2DIntVector; Radius: integer; CornerPos: TCornerPos;
  ClipRect: T2DIntRect; Convex: boolean);
var
  BufferRect, BitmapRect, TempRect: T2DIntRect;
  OrgSrcRect, UnClippedDstRect, OrgDstRect: T2DIntRect;
  SrcRect: T2DIntRect;
  Offset: T2DIntVector;
  Center: T2DIntVector;
  y: Integer;
  SrcLine: Pointer;
  DstLine: Pointer;
  SrcPtr, DstPtr : PByte;
  x: Integer;
  Dist : double;
  SrcImg, DestImg: TLazIntfImage;
begin
  if (ABuffer.PixelFormat <> pf24Bit) or (ABitmap.PixelFormat <> pf24Bit) then
    raise Exception.Create('TSpkGUITools.CopyRoundCorner: Only 24-bit bitmaps are accepted!');

  // Validation
  if Radius < 1 then
    exit;

  if (ABuffer.Width = 0) or (ABuffer.Height = 0) or
     (ABitmap.Width = 0) or (ABitmap.Height = 0) then exit;

  //todo minimize use of temps here
  {$ifdef EnhancedRecordSupport}
  BufferRect := T2DIntRect.Create(0, 0, ABuffer.width-1, ABuffer.height-1);
  if not BufferRect.IntersectsWith(
      T2DIntRect.Create(SrcPoint.x, SrcPoint.y, SrcPoint.x+Radius-1, SrcPoint.y+Radius-1),
      OrgSrcRect
    )
  then
    exit;
  {$else}
  BufferRect.Create(0, 0, ABuffer.Width-1, ABuffer.Height-1);
  TempRect.Create(SrcPoint.x, SrcPoint.y, SrcPoint.x+Radius-1, SrcPoint.y+Radius-1);
  if not BufferRect.IntersectsWith(TempRect, OrgSrcRect) then
    exit;
  {$endif}

  {$ifdef EnhancedRecordSupport}
  BitmapRect := T2DIntRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not BitmapRect.IntersectsWith(
      T2DIntRect.Create(DstPoint.x, DstPoint.y, DstPoint.x+Radius-1, DstPoint.y+Radius-1),
      UnClippedDstRect
    )
  then
    exit;
  {$else}
  BitmapRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  //todo: calling create twice
  TempRect.Create(DstPoint.x, DstPoint.y, DstPoint.x+Radius-1, DstPoint.y+Radius-1);
  if not(BitmapRect.IntersectsWith(TempRect, UnClippedDstRect)) then
    exit;
  {$endif}

  if not(ClipRect.IntersectsWith(UnClippedDstRect, OrgDstRect)) then
    exit;

  Offset := DstPoint - SrcPoint;

  if not(OrgSrcRect.IntersectsWith(OrgDstRect - Offset, SrcRect)) then
    exit;

  // We position the center of the arc
  {$ifdef EnhancedRecordSupport}
  case CornerPos of
    cpLeftTop:
      Center := T2DIntVector.Create(SrcPoint.x + Radius - 1, SrcPoint.y + Radius - 1);
    cpRightTop:
      Center := T2DIntVector.Create(SrcPoint.x, SrcPoint.y + Radius - 1);
    cpLeftBottom:
      Center := T2DIntVector.Create(SrcPoint.x + Radius - 1, SrcPoint.y);
    cpRightBottom:
      Center := T2DIntVector.Create(SrcPoint.x, SrcPoint.y);
  end;
  {$else}
  case CornerPos of
    cpLeftTop:
      Center.Create(SrcPoint.x + Radius - 1, SrcPoint.y + Radius - 1);
    cpRightTop:
      Center.Create(SrcPoint.x, SrcPoint.y + Radius - 1);
    cpLeftBottom:
      Center.Create(SrcPoint.x + Radius - 1, SrcPoint.y);
    cpRightBottom:
      Center.Create(SrcPoint.x, SrcPoint.y);
  end;
  {$endif}

  // Is there anything to be processed?
  if Convex then
  begin
    //todo: remove the check since is not necessary
    if (SrcRect.Left <= SrcRect.right) and (SrcRect.Top <= SrcRect.Bottom) then
    begin
      SrcImg := ABuffer.CreateIntfImage;
      DestImg := ABitmap.CreateIntfImage;
      for y := SrcRect.Top to SrcRect.Bottom do
      begin
        SrcLine := SrcImg.GetDataLineStart(y);
        DstLine := DestImg.GetDataLineStart(y+Offset.y);
        SrcPtr := {%H-}pointer({%H-}PtrInt(SrcLine) + SrcRect.Left*3);
        DstPtr := {%H-}pointer({%H-}PtrInt(DstLine) + 3*(SrcRect.Left + Offset.x));
        for x := SrcRect.Left to SrcRect.Right do
        begin
          {$ifdef EnhancedRecordSupport}
          Dist := Center.DistanceTo(T2DIntVector.Create(x, y));
          {$else}
          Dist := Center.DistanceTo(x, y);
          {$endif}
          if Dist <= (Radius-1) then
            Move(SrcPtr^, DstPtr^, 3);
          inc(SrcPtr, 3);
          inc(DstPtr, 3);
        end;
      end;
      ABitmap.LoadFromIntfImage(DestImg);
      SrcImg.Destroy;
      DestImg.Destroy;
    end;
  end else
  begin
    if (SrcRect.Left <= SrcRect.Right) and (SrcRect.Top <= SrcRect.Bottom) then
    begin
      SrcImg := ABuffer.CreateIntfImage;
      DestImg := ABitmap.CreateIntfImage;
      for y := SrcRect.Top to SrcRect.Bottom do
      begin
        SrcLine := SrcImg.GetDataLineStart(y);
        DstLine := DestImg.GetDataLineStart(y+Offset.y);
        SrcPtr := {%H-}pointer({%H-}PtrInt(SrcLine) + 3*SrcRect.Left);
        DstPtr := {%H-}pointer({%H-}PtrInt(DstLine) + 3*(SrcRect.Left + Offset.x));
        for x := SrcRect.Left to SrcRect.Right do
        begin
          {$ifdef EnhancedRecordSupport}
          Dist := Center.DistanceTo(T2DIntVector.Create(x, y));
          {$else}
          Dist := Center.DistanceTo(x, y);
          {$endif}
          if Dist >= (Radius-1) then
            Move(SrcPtr^, DstPtr^, 3);
          inc(SrcPtr,3);
          inc(DstPtr,3);
        end;
      end;
      ABitmap.LoadFromIntfImage(DestImg);
      SrcImg.Destroy;
      DestImg.Destroy;
    end;
  end;
end;

class procedure TGUITools.CopyRoundRect(ABuffer, ABitmap: TBitmap; SrcPoint,
  DstPoint: T2DIntVector; Width, Height, Radius: integer; ClipRect: T2DIntRect;
  LeftTopRound, RightTopRound, LeftBottomRound, RightBottomRound: boolean);
begin
  if (ABuffer.PixelFormat <> pf24Bit) or (ABitmap.PixelFormat <> pf24Bit) then
   raise Exception.Create('TSpkGUITools.CopyBackground: Only 24 bit bitmaps are accepted!');

  if Radius < 0 then
    exit;

  if (Radius > Width div 2) or (Radius > Height div 2) then
    exit;

  if (ABuffer.Width = 0) or (ABuffer.Height = 0) or
     (ABitmap.Width = 0) or (ABitmap.Height = 0) then exit;

  {$REGION 'We fill the rectangles'}
  // Mountain /????
  // Góra
  CopyRectangle(ABuffer,
               ABitmap,
               {$ifdef EnhancedRecordSupport}
               T2DIntPoint.Create(SrcPoint.x + Radius, SrcPoint.y),
               T2DIntPoint.Create(DstPoint.x + Radius, DstPoint.y),
               {$else}
               Create2DIntPoint(SrcPoint.x + Radius, SrcPoint.y),
               Create2DIntPoint(DstPoint.x + Radius, DstPoint.y),
               {$endif}
               Width - 2*Radius,
               Radius,
               ClipRect);
  // Down
  // Dó³
  CopyRectangle(ABuffer,
               ABitmap,
               {$IFDEF EnhancedRecordSupport}
               T2DIntPoint.Create(SrcPoint.x + Radius, SrcPoint.y + Height - Radius),
               T2DIntPoint.Create(DstPoint.x + Radius, DstPoint.y + Height - Radius),
               {$ELSE}
               Create2DIntPoint(SrcPoint.x + Radius, SrcPoint.y + Height - Radius),
               Create2DIntPoint(DstPoint.x + Radius, DstPoint.y + Height - Radius),
               {$ENDIF}
               Width - 2*Radius,
               Radius,
               ClipRect);
  // Agent (???)
  // Œrodek
  CopyRectangle(ABuffer,
               ABitmap,
               {$IFDEF EnhancedRecordSupport}
               T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Radius),
               T2DIntPoint.Create(DstPoint.x, DstPoint.y + Radius),
               {$ELSE}
               Create2DIntPoint(SrcPoint.x, SrcPoint.y + Radius),
               Create2DIntPoint(DstPoint.x, DstPoint.y + Radius),
               {$ENDIF}
               Width,
               Height - 2*Radius,
               ClipRect);
{$ENDREGION}

  // We fill the corners
{$REGION 'Left upper'}
  if LeftTopRound then
    TGUITools.CopyRoundCorner(ABuffer,
                              ABitmap,
                              {$IFDEF EnhancedRecordSupport}
                              T2DIntPoint.Create(SrcPoint.x, SrcPoint.y),
                              T2DIntPoint.Create(DstPoint.x, DstPoint.y),
                              {$ELSE}
                              Create2DIntPoint(SrcPoint.x, SrcPoint.y),
                              Create2DIntPoint(DstPoint.x, DstPoint.y),
                              {$ENDIF}
                              Radius,
                              cpLeftTop,
                              ClipRect,
                              true)
  else
    TGUITools.CopyCorner(ABuffer,
                         ABitmap,
                         {$IFDEF EnhancedRecordSupport}
                         T2DIntPoint.Create(SrcPoint.x, SrcPoint.y),
                         T2DIntPoint.Create(DstPoint.x, DstPoint.y),
                         {$ELSE}
                         Create2DIntPoint(SrcPoint.x, SrcPoint.y),
                         Create2DIntPoint(DstPoint.x, DstPoint.y),
                         {$ENDIF}
                         Radius,
                         ClipRect);
{$ENDREGION}

{$REGION 'Right upper'}
  if RightTopRound then
    TGUITools.CopyRoundCorner(ABuffer,
                              ABitmap,
                              {$IFDEF EnhancedRecordSupport}
                              T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y),
                              T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y),
                              {$ELSE}
                              Create2DIntPoint(SrcPoint.x + Width - Radius, SrcPoint.y),
                              Create2DIntPoint(DstPoint.x + Width - Radius, DstPoint.y),
                              {$ENDIF}
                              Radius,
                              cpRightTop,
                              ClipRect,
                              true)
  else
    TGUITools.CopyCorner(ABuffer,
                         ABitmap,
                         {$IFDEF EnhancedRecordSupport}
                         T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y),
                         T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y),
                         {$ELSE}
                         Create2DIntPoint(SrcPoint.x + Width - Radius, SrcPoint.y),
                         Create2DIntPoint(DstPoint.x + Width - Radius, DstPoint.y),
                         {$ENDIF}
                         Radius,
                         ClipRect);
{$ENDREGION}

{$REGION 'Left bottom'}
  if LeftBottomRound then
    TGUITools.CopyRoundCorner(ABuffer,
                              ABitmap,
                              {$IFDEF EnhancedRecordSupport}
                              T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Height - Radius),
                              T2DIntPoint.Create(DstPoint.x, DstPoint.y + Height - Radius),
                              {$ELSE}
                              Create2DIntPoint(SrcPoint.x, SrcPoint.y + Height - Radius),
                              Create2DIntPoint(DstPoint.x, DstPoint.y + Height - Radius),
                              {$ENDIF}
                              Radius,
                              cpLeftBottom,
                              ClipRect,
                              true)
  else
    TGUITools.CopyCorner(ABuffer,
                         ABitmap,
                         {$IFDEF EnhancedRecordSupport}
                         T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Height - Radius),
                         T2DIntPoint.Create(DstPoint.x, DstPoint.y + Height - Radius),
                         {$ELSE}
                         Create2DIntPoint(SrcPoint.x, SrcPoint.y + Height - Radius),
                         Create2DIntPoint(DstPoint.x, DstPoint.y + Height - Radius),
                         {$ENDIF}
                         Radius,
                         ClipRect);
{$ENDREGION}

{$REGION 'Right bottom'}
  if RightBottomRound then
    TGUITools.CopyRoundCorner(ABuffer,
                              ABitmap,
                              {$IFDEF EnhancedRecordSupport}
                              T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius),
                              T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius),
                              {$ELSE}
                              Create2DIntPoint(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius),
                              Create2DIntPoint(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius),
                              {$ENDIF}
                              Radius,
                              cpRightBottom,
                              ClipRect,
                              true)
  else
    TGUITools.CopyCorner(ABuffer,
                         ABitmap,
                         {$IFDEF EnhancedRecordSupport}
                         T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius),
                         T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius),
                         {$ELSE}
                         Create2DIntPoint(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius),
                         Create2DIntPoint(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius),
                         {$ENDIF}
                         Radius,
                         ClipRect);
{$ENDREGION'}
end;

class procedure TGUITools.CopyRoundRect(ABuffer : TBitmap; ABitmap: TBitmap; SrcPoint,
  DstPoint: T2DIntVector; Width, Height, Radius: integer; LeftTopRound,
  RightTopRound, LeftBottomRound, RightBottomRound: boolean);
begin
  if (ABuffer.PixelFormat <> pf24bit) or (ABitmap.PixelFormat <> pf24bit) then
    raise exception.create('TSpkGUITools.CopyBackground: Only 24 bit bitmaps are accepted!');

  if Radius < 0 then
    exit;

  if (Radius > Width div 2) or (Radius > Height div 2) then
    exit;

  if (ABuffer.Width = 0) or (ABuffer.Height = 0) or
     (ABitmap.Width = 0) or (ABitmap.Height = 0) then exit;

{$REGION 'We fill the rectangles'}
  // Góra
  CopyRectangle(ABuffer,
                ABitmap,
                {$IFDEF EnhancedRecordSupport}
                T2DIntPoint.Create(SrcPoint.x + Radius, SrcPoint.y),
                T2DIntPoint.Create(DstPoint.x + Radius, DstPoint.y),
                {$ELSE}
                Create2DIntPoint(SrcPoint.x + Radius, SrcPoint.y),
                Create2DIntPoint(DstPoint.x + Radius, DstPoint.y),
                {$ENDIF}
                Width - 2*Radius,
                Radius);
  // Dó³
  CopyRectangle(ABuffer,
                ABitmap,
                {$IFDEF EnhancedRecordSupport}
                T2DIntPoint.Create(SrcPoint.x + Radius, SrcPoint.y + Height - radius),
                T2DIntPoint.Create(DstPoint.x + Radius, DstPoint.y + Height - radius),
                {$ELSE}
                Create2DIntPoint(SrcPoint.x + Radius, SrcPoint.y + Height - radius),
                Create2DIntPoint(DstPoint.x + Radius, DstPoint.y + Height - radius),
                {$ENDIF}
                Width - 2*Radius,
                Radius);
  // Œrodek
  CopyRectangle(ABuffer,
               ABitmap,
               {$IFDEF EnhancedRecordSupport}
               T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Radius),
               T2DIntPoint.Create(DstPoint.x, DstPoint.y + Radius),
               {$ELSE}
               Create2DIntPoint(SrcPoint.x, SrcPoint.y + Radius),
               Create2DIntPoint(DstPoint.x, DstPoint.y + Radius),
               {$ENDIF}
               Width,
               Height - 2*Radius);
{$ENDREGION}

  // We fill the corners
{$REGION 'Left upper'}
  if LeftTopRound then
    TGUITools.CopyRoundCorner(ABuffer,
                              ABitmap,
                              {$IFDEF EnhancedRecordSupport}
                              T2DIntPoint.Create(SrcPoint.x, SrcPoint.y),
                              T2DIntPoint.Create(DstPoint.x, DstPoint.y),
                              {$ELSE}
                              Create2DIntPoint(SrcPoint.x, SrcPoint.y),
                              Create2DIntPoint(DstPoint.x, DstPoint.y),
                              {$ENDIF}
                              Radius,
                              cpLeftTop,
                              true)
  else
    TGUITools.CopyCorner(ABuffer,
                         ABitmap,
                         {$IFDEF EnhancedRecordSupport}
                         T2DIntPoint.Create(SrcPoint.x, SrcPoint.y),
                         T2DIntPoint.Create(DstPoint.x, DstPoint.y),
                         {$ELSE}
                         Create2DIntPoint(SrcPoint.x, SrcPoint.y),
                         Create2DIntPoint(DstPoint.x, DstPoint.y),
                         {$ENDIF}
                         Radius);
{$ENDREGION}

{$REGION 'Right upper'}
  if RightTopRound then
    TGUITools.CopyRoundCorner(ABuffer,
                              ABitmap,
                              {$IFDEF EnhancedRecordSupport}
                              T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y),
                              T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y),
                              {$ELSE}
                              Create2DIntPoint(SrcPoint.x + Width - Radius, SrcPoint.y),
                              Create2DIntPoint(DstPoint.x + Width - Radius, DstPoint.y),
                              {$ENDIF}
                              Radius,
                              cpRightTop,
                              true)
  else
    TGUITools.CopyCorner(ABuffer,
                         ABitmap,
                         {$IFDEF EnhancedRecordSupport}
                         T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y),
                         T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y),
                         {$ELSE}
                         Create2DIntPoint(SrcPoint.x + Width - Radius, SrcPoint.y),
                         Create2DIntPoint(DstPoint.x + Width - Radius, DstPoint.y),
                         {$ENDIF}
                         Radius);
{$ENDREGION}

{$REGION 'Left bottom'}
  if LeftBottomRound then
    TGUITools.CopyRoundCorner(ABuffer,
                              ABitmap,
                              {$IFDEF EnhancedRecordSupport}
                              T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Height - Radius),
                              T2DIntPoint.Create(DstPoint.x, DstPoint.y + Height - Radius),
                              {$ELSE}
                              Create2DIntPoint(SrcPoint.x, SrcPoint.y + Height - Radius),
                              Create2DIntPoint(DstPoint.x, DstPoint.y + Height - Radius),
                              {$ENDIF}
                              Radius,
                              cpLeftBottom,
                              true)
  else
    TGUITools.CopyCorner(ABuffer,
                         ABitmap,
                         {$IFDEF EnhancedRecordSupport}
                         T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Height - Radius),
                         T2DIntPoint.Create(DstPoint.x, DstPoint.y + Height - Radius),
                         {$ELSE}
                         Create2DIntPoint(SrcPoint.x, SrcPoint.y + Height - Radius),
                         Create2DIntPoint(DstPoint.x, DstPoint.y + Height - Radius),
                         {$ENDIF}
                         Radius);
{$ENDREGION}

{$REGION 'Right bottom'}
  if RightBottomRound then
    TGUITools.CopyRoundCorner(ABuffer,
                              ABitmap,
                              {$IFDEF EnhancedRecordSupport}
                              T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius),
                              T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius),
                              {$ELSE}
                              Create2DIntPoint(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius),
                              Create2DIntPoint(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius),
                              {$ENDIF}
                              Radius,
                              cpRightBottom,
                              true)
  else
    TGUITools.CopyCorner(ABuffer,
                         ABitmap,
                         {$IFDEF EnhancedRecordSupport}
                         T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius),
                         T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius),
                         {$ELSE}
                         Create2DIntPoint(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius),
                         Create2DIntPoint(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius),
                         {$ENDIF}
                         Radius);
{$ENDREGION}
end;

class procedure TGUITools.CopyRectangle(ABuffer, ABitmap: TBitmap; SrcPoint,
  DstPoint: T2DIntVector; Width, Height: integer);
var
  BufferRect, BitmapRect: T2DIntRect;
  SrcRect, DstRect: T2DIntRect;
  ClippedSrcRect: T2DIntRect;
  Offset: T2DIntVector;
  y: Integer;
  SrcLine: Pointer;
  DstLine: Pointer;
  SrcImg: TLazIntfImage;
  DestImg: TLazIntfImage;
begin
  if (ABuffer.PixelFormat <> pf24Bit) or (ABitmap.PixelFormat <> pf24Bit) then
    raise exception.create('TSpkGUITools.CopyRoundCorner: Only 24 bit bitmaps are accepted!');

  // Validation
  if (Width < 1) or (Height < 1) then
    exit;

  if (ABuffer.Width = 0) or (ABuffer.Height = 0) or
     (ABitmap.Width = 0) or (ABitmap.Height = 0) then exit;

  {$IFDEF EnhancedRecordSupport}
  // Truncate the source rect to the source bitmap
  BufferRect := T2DIntRect.Create(0, 0, ABuffer.Width-1, ABuffer.Height-1);
  if not BufferRect.IntersectsWith(
      T2DIntRect.Create(SrcPoint.x, SrcPoint.y, SrcPoint.x+Width-1, SrcPoint.y+Height-1),
      SrcRect
    )
  then
    exit;

  // We cut the target rect to the target bitmap
  BitmapRect := T2DIntRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not BitmapRect.IntersectsWith(
      T2DIntRect.Create(DstPoint.x, DstPoint.y, DstPoint.x+Width-1, DstPoint.y+Height-1),
      DstRect
    )
  then
    exit;
  {$ELSE}
  // Truncate the source rect to the source bitmap
  BufferRect.Create(0, 0, ABuffer.Width-1, ABuffer.Height-1);
  if not BufferRect.IntersectsWith(
      Create2DIntRect(SrcPoint.x, SrcPoint.y, SrcPoint.x+Width-1, SrcPoint.y+Height-1),
      SrcRect
    )
  then
    exit;

  // We cut the target rect to the target bitmap
  BitmapRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not BitmapRect.IntersectsWith(
      Create2DIntRect(DstPoint.x, DstPoint.y, DstPoint.x+Width-1, DstPoint.y+Height-1),
      DstRect
    )
  then
    exit;
{$ENDIF}

  // We are counting the source offset to the target recta
  Offset := DstPoint - SrcPoint;

  // Sprawdzamy, czy na³o¿one na siebie recty: Ÿród³owy i docelowy przesuniêty o
  // offset maj¹ jak¹œ czêœæ wspóln¹
  // Google-translated:
  // Verify that the rectangular overhead: source and target shifted by offset have some common
  if not SrcRect.IntersectsWith(DstRect - Offset, ClippedSrcRect) then
    exit;

  // If there is anything to process, do the operation
  if (ClippedSrcRect.Left <= ClippedSrcRect.Right) and
     (ClippedSrcRect.Top <= ClippedSrcRect.Bottom) then
  begin
    SrcImg := ABuffer.CreateIntfImage;
    DestImg := ABitmap.CreateIntfImage;
    for y := ClippedSrcRect.Top to ClippedSrcRect.Bottom do
    begin
      SrcLine := SrcImg.GetDataLineStart(y);
      DstLine := DestImg.GetDataLineStart(y+Offset.y);
      Move({%H-}pointer({%H-}PtrInt(SrcLine) + 3*ClippedSrcRect.Left)^,
           {%H-}pointer({%H-}PtrInt(DstLine) + 3*(ClippedSrcRect.Left + Offset.x))^,
           3*ClippedSrcRect.Width);
    end;
    ABitmap.LoadFromIntfImage(DestImg);
    SrcImg.Destroy;
    DestImg.Destroy;
  end;
end;

class procedure TGUITools.CopyCorner(ABuffer, ABitmap: TBitmap;
  SrcPoint, DstPoint: T2DIntVector; Radius: integer);
begin
  CopyRectangle(ABuffer, ABitmap, SrcPoint, DstPoint, Radius, Radius);
end;

class procedure TGUITools.CopyCorner(ABuffer, ABitmap: TBitmap; SrcPoint,
  DstPoint: T2DIntVector; Radius: integer; ClipRect: T2DIntRect);
begin
  CopyRectangle(ABuffer, ABitmap, SrcPoint, DstPoint, Radius, Radius, ClipRect);
end;

class procedure TGUITools.CopyMaskRectangle(ABuffer, AMask, ABitmap: TBitmap;
  SrcPoint, DstPoint: T2DIntVector; Width, Height: integer);
var
  BufferRect, BitmapRect: T2DIntRect;
  SrcRect, DstRect: T2DIntRect;
  ClippedSrcRect: T2DIntRect;
  Offset: T2DIntVector;
  y: Integer;
  SrcLine: Pointer;
  MaskLine: Pointer;
  DstLine: Pointer;
  SrcImg: TLazIntfImage;
  MaskImg: TLazIntfImage;
  DestImg: TLazIntfImage;
  i: Integer;
begin
  if (ABuffer.PixelFormat <> pf24Bit) or (ABitmap.PixelFormat <> pf24Bit) then
    raise Exception.Create('TSpkGUITools.CopyRoundCorner: Only 24 bit bitmaps are accepted!');

 if (AMask.PixelFormat <> pf8bit) then
   raise Exception.Create('TSpkGUITools.CopyRoundCorner: Only 8-bit masks are accepted!');

  // Validation
  if (Width < 1) or (Height < 1) then
    exit;

  if (ABuffer.Width = 0) or (ABuffer.Height = 0) or
     (ABitmap.Width = 0) or (ABitmap.Height = 0) then exit;

  if (ABuffer.Width <> AMask.Width) or (ABuffer.Height <> AMask.Height) then
    exit;

  {$IFDEF EnhancedRecordSupport}
  // Truncate the source rect to the source bitmap
  BufferRect := T2DIntRect.Create(0, 0, ABuffer.Width-1, ABuffer.Height-1);
  if not BufferRect.IntersectsWith(
      T2DIntRect.Create(SrcPoint.x, SrcPoint.y, SrcPoint.x+Width-1, SrcPoint.y+Height-1),
      SrcRect
    ) then
    exit;
  // We cut the target rect to the target bitmap
  BitmapRect := T2DIntRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not BitmapRect.IntersectsWith(
      T2DIntRect.Create(DstPoint.x, DstPoint.y, DstPoint.x+Width-1, DstPoint.y+Height-1),
      DstRect
    ) then
    exit;
  {$ELSE}
  // Truncate the source rect to the source bitmap
  BufferRect.Create(0, 0, ABuffer.Width-1, ABuffer.Height-1);
  if not BufferRect.IntersectsWith(
      Create2DIntRect(SrcPoint.x, SrcPoint.y, SrcPoint.x+Width-1, SrcPoint.y+Height-1),
      SrcRect
    ) then
    exit;
  // Trim the target rect to the target bitmap
  BitmapRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not BitmapRect.IntersectsWith(
      Create2DIntRect(DstPoint.x, DstPoint.y, DstPoint.x+Width-1, DstPoint.y+Height-1),
      DstRect
    ) then
    exit;
  {$ENDIF}

  // We are counting the source offset to the target recta
  Offset := DstPoint - SrcPoint;

  // Sprawdzamy, czy na³o¿one na siebie recty: Ÿród³owy i docelowy przesuniêty o
  // offset maj¹ jak¹œ czêœæ wspóln¹
  // Google-translated:
  // We check that the rectangles that are superimposed on each other:
  // source and target shifted by offset have some common
  if not(SrcRect.IntersectsWith(DstRect - Offset, ClippedSrcRect)) then
    exit;

  // If there is anything to process, do the operation
  if (ClippedSrcRect.Left <= ClippedSrcRect.Right) and
     (ClippedSrcRect.Top <= ClippedSrcRect.Bottom) then
  begin
    SrcImg := ABuffer.CreateIntfImage;
    DestImg := ABitmap.CreateIntfImage;
    MaskImg := AMask.CreateIntfImage;
    for y := ClippedSrcRect.Top to ClippedSrcRect.Bottom do
    begin
      SrcLine := SrcImg.GetDataLineStart(y);
      SrcLine := {%H-}pointer({%H-}PtrInt(SrcLine) + 3 * ClippedSrcRect.left);
      MaskLine := MaskImg.GetDataLineStart(y);
      MaskLine := {%H-}pointer({%H-}PtrInt(MaskLine) + ClippedSrcRect.left);
      DstLine := DestImg.GetDataLineStart(y+Offset.y);
      DstLine := {%H-}pointer({%H-}PtrInt(DstLine) + 3 * (ClippedSrcRect.left + Offset.x));
      for i := 0 to ClippedSrcRect.Width - 1 do
      begin
        if PByte(MaskLine)^ < 128 then
          Move(SrcLine^, DstLine^, 3);
        SrcLine := {%H-}pointer({%H-}PtrInt(SrcLine)+3);
        DstLine := {%H-}pointer({%H-}PtrInt(DstLine)+3);
        MaskLine := {%H-}pointer({%H-}PtrInt(MaskLine)+1);
      end;
    end;
    ABitmap.LoadFromIntfImage(DestImg);
    DestImg.Destroy;
    SrcImg.Destroy;
    MaskImg.Destroy;
  end;
end;

class procedure TGUITools.CopyMaskRectangle(ABuffer, AMask, ABitmap: TBitmap;
  SrcPoint, DstPoint: T2DIntVector; Width, Height: integer;
  ClipRect: T2DIntRect);
var
  BufferRect, BitmapRect: T2DIntRect;
  SrcRect, DstRect: T2DIntRect;
  ClippedSrcRect, ClippedDstRect: T2DIntRect;
  Offset: T2DIntVector;
  y: Integer;
  SrcImg: TLazIntfImage;
  MaskImg: TLazIntfImage;
  DestImg: TLazIntfImage;
  SrcLine: Pointer;
  DstLine: Pointer;
  i: Integer;
  MaskLine: Pointer;
begin
  if (ABuffer.PixelFormat <> pf24Bit) or (ABitmap.PixelFormat <> pf24Bit) then
    raise Exception.Create('TSpkGUITools.CopyMaskRectangle: Only 24 bit bitmaps are accepted!');
  if AMask.PixelFormat<>pf8bit then
    raise Exception.Create('TSpkGUITools.CopyMaskRectangle: Only 8-bit masks are accepted!');

  // Validation
  if (Width < 1) or (Height < 1) then
    exit;

  if (ABuffer.Width = 0) or (ABuffer.Height = 0) or
     (ABitmap.Width = 0) or (ABitmap.Height = 0) then exit;

  if (ABuffer.Width <> AMask.Width) or
     (ABuffer.Height <> AMask.Height)
  then
    raise Exception.Create('TSpkGUITools.CopyMaskRectangle: The mask has incorrect dimensions!');

  {$IFDEF EnhancedRecordSupport}
  // Truncate the source rect to the source bitmap
  BufferRect := T2DIntRect.Create(0, 0, ABuffer.Width-1, ABuffer.Height-1);
  if not BufferRect.IntersectsWith(
      T2DIntRect.Create(SrcPoint.x, SrcPoint.y, SrcPoint.x+Width-1, SrcPoint.y+Height-1),
      SrcRect
    )
  then
    exit;

// Przycinamy docelowy rect do obszaru docelowej bitmapy
BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1);
if not(BitmapRect.IntersectsWith(T2DIntRect.create(DstPoint.x,
                                                   DstPoint.y,
                                                   DstPoint.x+Width-1,
                                                   DstPoint.y+Height-1),
                                 DstRect)) then exit;
{$ELSE}
// Przycinamy Ÿród³owy rect do obszaru Ÿród³owej bitmapy
BufferRect.create(0, 0, ABuffer.width-1, ABuffer.height-1);
if not(BufferRect.IntersectsWith(Create2DIntRect(SrcPoint.x,
                                                   SrcPoint.y,
                                                   SrcPoint.x+Width-1,
                                                   SrcPoint.y+Height-1),
                                 SrcRect)) then exit;

// Przycinamy docelowy rect do obszaru docelowej bitmapy
BitmapRect.create(0, 0, ABitmap.width-1, ABitmap.height-1);
if not(BitmapRect.IntersectsWith(Create2DIntRect(DstPoint.x,
                                                   DstPoint.y,
                                                   DstPoint.x+Width-1,
                                                   DstPoint.y+Height-1),
                                 DstRect)) then exit;
{$ENDIF}

// Dodatkowo przycinamy docelowy rect
if not(DstRect.IntersectsWith(ClipRect, ClippedDstRect)) then
   Exit;

// Liczymy offset Ÿród³owego do docelowego recta
Offset:=DstPoint - SrcPoint;

// Sprawdzamy, czy na³o¿one na siebie recty: Ÿród³owy i docelowy przesuniêty o
// offset maj¹ jak¹œ czêœæ wspóln¹
if not(SrcRect.IntersectsWith(ClippedDstRect - Offset, ClippedSrcRect)) then exit;

// Jeœli jest cokolwiek do przetworzenia, wykonaj operacjê
if (ClippedSrcRect.left<=ClippedSrcRect.right) and (ClippedSrcRect.top<=ClippedSrcRect.bottom) then
begin
  SrcImg := ABuffer.CreateIntfImage;
  DestImg := ABitmap.CreateIntfImage;
  MaskImg := ABitmap.CreateIntfImage;
   for y := ClippedSrcRect.top to ClippedSrcRect.bottom do
       begin
       SrcLine:=SrcImg.GetDataLineStart(y);
       SrcLine:={%H-}pointer({%H-}PtrInt(SrcLine) + 3 * ClippedSrcRect.left);

       MaskLine:=MaskImg.GetDataLineStart(y);
       MaskLine:={%H-}pointer({%H-}PtrInt(MaskLine) + ClippedSrcRect.left);

       DstLine:=DestImg.GetDataLineStart(y+Offset.y);
       DstLine:={%H-}pointer({%H-}PtrInt(DstLine) + 3 * (ClippedSrcRect.left + Offset.x));

       for i := 0 to ClippedSrcRect.width - 1 do
           begin
           if PByte(MaskLine)^<128 then
              Move(SrcLine^, DstLine^, 3);

           SrcLine:={%H-}pointer({%H-}PtrInt(SrcLine)+3);
           DstLine:={%H-}pointer({%H-}PtrInt(DstLine)+3);
           MaskLine:={%H-}pointer({%H-}PtrInt(MaskLine)+1);
           end;
       end;
   ABitmap.LoadFromIntfImage(DestImg);
   SrcImg.Destroy;
   DestImg.Destroy;
   MaskImg.Destroy;
end;
end;

class procedure TGUITools.CopyRectangle(ABuffer, ABitmap: TBitmap; SrcPoint,
  DstPoint: T2DIntVector; Width, Height: integer; ClipRect: T2DIntRect);

var BufferRect, BitmapRect : T2DIntRect;
    SrcRect, DstRect : T2DIntRect;
    ClippedSrcRect, ClippedDstRect : T2DIntRect;
    Offset : T2DIntVector;
    y: Integer;
    DestImg: TLazIntfImage;
    SrcImg: TLazIntfImage;
    SrcLine: Pointer;
    DstLine: Pointer;

begin
if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then
   raise exception.create('TSpkGUITools.CopyRoundCorner: Tylko 24-bitowe bitmapy s¹ akceptowane!');

// Sprawdzanie poprawnoœci
if (Width<1) or (Height<1) then
   exit;

if (ABuffer.width=0) or (ABuffer.height=0) or
   (ABitmap.width=0) or (ABitmap.height=0) then exit;

{$IFDEF EnhancedRecordSupport}
// Przycinamy Ÿród³owy rect do obszaru Ÿród³owej bitmapy
BufferRect:=T2DIntRect.create(0, 0, ABuffer.width-1, ABuffer.height-1);
if not(BufferRect.IntersectsWith(T2DIntRect.create(SrcPoint.x,
                                                   SrcPoint.y,
                                                   SrcPoint.x+Width-1,
                                                   SrcPoint.y+Height-1),
                                 SrcRect)) then exit;

// Przycinamy docelowy rect do obszaru docelowej bitmapy
BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1);
if not(BitmapRect.IntersectsWith(T2DIntRect.create(DstPoint.x,
                                                   DstPoint.y,
                                                   DstPoint.x+Width-1,
                                                   DstPoint.y+Height-1),
                                 DstRect)) then exit;
{$ELSE}
// Przycinamy Ÿród³owy rect do obszaru Ÿród³owej bitmapy
BufferRect.create(0, 0, ABuffer.width-1, ABuffer.height-1);
if not(BufferRect.IntersectsWith(Create2DIntRect(SrcPoint.x,
                                                   SrcPoint.y,
                                                   SrcPoint.x+Width-1,
                                                   SrcPoint.y+Height-1),
                                 SrcRect)) then exit;

// Przycinamy docelowy rect do obszaru docelowej bitmapy
BitmapRect.create(0, 0, ABitmap.width-1, ABitmap.height-1);
if not(BitmapRect.IntersectsWith(Create2DIntRect(DstPoint.x,
                                                   DstPoint.y,
                                                   DstPoint.x+Width-1,
                                                   DstPoint.y+Height-1),
                                 DstRect)) then exit;
{$ENDIF}

// Dodatkowo przycinamy docelowy rect
if not(DstRect.IntersectsWith(ClipRect, ClippedDstRect)) then
   Exit;

// Liczymy offset Ÿród³owego do docelowego recta
Offset:=DstPoint - SrcPoint;

// Sprawdzamy, czy na³o¿one na siebie recty: Ÿród³owy i docelowy przesuniêty o
// offset maj¹ jak¹œ czêœæ wspóln¹
if not(SrcRect.IntersectsWith(ClippedDstRect - Offset, ClippedSrcRect)) then exit;

// Jeœli jest cokolwiek do przetworzenia, wykonaj operacjê
if (ClippedSrcRect.left<=ClippedSrcRect.right) and (ClippedSrcRect.top<=ClippedSrcRect.bottom) then
begin
  SrcImg := ABuffer.CreateIntfImage;
  DestImg := ABitmap.CreateIntfImage;
   for y := ClippedSrcRect.top to ClippedSrcRect.bottom do
       begin
       SrcLine:=SrcImg.GetDataLineStart(y);
       DstLine:=DestImg.GetDataLineStart(y+Offset.y);

       Move({%H-}pointer({%H-}PtrInt(SrcLine) + 3*ClippedSrcRect.left)^,
            {%H-}pointer({%H-}PtrInt(DstLine) + 3*(ClippedSrcRect.left + Offset.x))^,
            3*ClippedSrcRect.Width);
       end;
  ABitmap.LoadFromIntfImage(DestImg);
  DestImg.Destroy;
  SrcImg.Destroy;
end;
end;

class procedure TGUITools.CopyRoundCorner(ABuffer: TBitmap; ABitmap: TBitmap;
  SrcPoint, DstPoint: T2DIntVector; Radius: integer; CornerPos: TCornerPos;
  Convex: boolean);

var BufferRect, BitmapRect : T2DIntRect;
    OrgSrcRect, OrgDstRect : T2DIntRect;
    SrcRect : T2DIntRect;
    Offset : T2DIntVector;
    Center: T2DIntVector;
    y: Integer;
    SrcImg: TLazIntfImage;
    DestImg: TLazIntfImage;
    SrcLine: Pointer;
    DstLine: Pointer;
    SrcPtr, DstPtr : PByte;
    x: Integer;
    Dist : double;

begin
if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then
   raise exception.create('TSpkGUITools.CopyRoundCorner: Tylko 24-bitowe bitmapy s¹ akceptowane!');

// Sprawdzanie poprawnoœci
if Radius<1 then
   exit;

if (ABuffer.width=0) or (ABuffer.height=0) or
   (ABitmap.width=0) or (ABitmap.height=0) then exit;

{$IFDEF EnhancedRecordSupport}
BufferRect:=T2DIntRect.create(0, 0, ABuffer.width-1, ABuffer.height-1);
if not(BufferRect.IntersectsWith(T2DIntRect.create(SrcPoint.x,
                                                   SrcPoint.y,
                                                   SrcPoint.x+Radius-1,
                                                   SrcPoint.y+Radius-1),
                                 OrgSrcRect)) then exit;

BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1);
if not(BitmapRect.IntersectsWith(T2DIntRect.create(DstPoint.x,
                                                   DstPoint.y,
                                                   DstPoint.x+Radius-1,
                                                   DstPoint.y+Radius-1),
                                 OrgDstRect)) then exit;
{$ELSE}
BufferRect.create(0, 0, ABuffer.width-1, ABuffer.height-1);
if not(BufferRect.IntersectsWith(Create2DIntRect(SrcPoint.x,
                                                   SrcPoint.y,
                                                   SrcPoint.x+Radius-1,
                                                   SrcPoint.y+Radius-1),
                                 OrgSrcRect)) then exit;

BitmapRect.create(0, 0, ABitmap.width-1, ABitmap.height-1);
if not(BitmapRect.IntersectsWith(Create2DIntRect(DstPoint.x,
                                                   DstPoint.y,
                                                   DstPoint.x+Radius-1,
                                                   DstPoint.y+Radius-1),
                                 OrgDstRect)) then exit;
{$ENDIF}

Offset:=DstPoint - SrcPoint;

if not(OrgSrcRect.IntersectsWith(OrgDstRect - Offset, SrcRect)) then exit;

// Ustalamy pozycjê œrodka ³uku

{$IFDEF EnhancedRecordSupport}
case CornerPos of
     cpLeftTop: Center:=T2DIntVector.create(SrcPoint.x + radius - 1, SrcPoint.y + Radius - 1);
     cpRightTop: Center:=T2DIntVector.create(SrcPoint.x, SrcPoint.y + Radius - 1);
     cpLeftBottom: Center:=T2DIntVector.Create(SrcPoint.x + radius - 1, SrcPoint.y);
     cpRightBottom: Center:=T2DIntVector.Create(SrcPoint.x, SrcPoint.y);
end;
{$ELSE}
case CornerPos of
     cpLeftTop: Center.create(SrcPoint.x + radius - 1, SrcPoint.y + Radius - 1);
     cpRightTop: Center.create(SrcPoint.x, SrcPoint.y + Radius - 1);
     cpLeftBottom: Center.Create(SrcPoint.x + radius - 1, SrcPoint.y);
     cpRightBottom: Center.Create(SrcPoint.x, SrcPoint.y);
end;
{$ENDIF}

// Czy jest cokolwiek do przetworzenia?
if Convex then
   begin
   if (SrcRect.left<=SrcRect.right) and (SrcRect.top<=SrcRect.bottom) then
   begin
     SrcImg := ABuffer.CreateIntfImage;
     DestImg := ABitmap.CreateIntfImage;
      for y := SrcRect.top to SrcRect.bottom do
          begin
          SrcLine:=SrcImg.GetDataLineStart(y);
          DstLine:=DestImg.GetDataLineStart(y+Offset.y);

          SrcPtr:={%H-}pointer({%H-}PtrInt(SrcLine) + 3*SrcRect.left);
          DstPtr:={%H-}pointer({%H-}PtrInt(DstLine) + 3*(SrcRect.left + Offset.x));
          for x := SrcRect.left to SrcRect.right do
              begin
              {$IFDEF EnhancedRecordSupport}
              Dist:=Center.DistanceTo(T2DVector.create(x, y));
              {$ELSE}
              Dist:=Center.DistanceTo(x, y);
              {$ENDIF}
              if Dist <= (Radius-1) then
                 Move(SrcPtr^,DstPtr^,3);

              inc(SrcPtr,3);
              inc(DstPtr,3);
              end;
          end;
      ABitmap.LoadFromIntfImage(DestImg);
      SrcImg.Destroy;
      DestImg.Destroy;
    end;
   end
else
   begin
   if (SrcRect.left<=SrcRect.right) and (SrcRect.top<=SrcRect.bottom) then
   begin
     SrcImg := ABuffer.CreateIntfImage;
     DestImg := ABitmap.CreateIntfImage;
      for y := SrcRect.top to SrcRect.bottom do
          begin
          SrcLine:=SrcImg.GetDataLineStart(y);
          DstLine:=DestImg.GetDataLineStart(y+Offset.y);

          SrcPtr:={%H-}pointer({%H-}PtrInt(SrcLine) + 3*SrcRect.left);
          DstPtr:={%H-}pointer({%H-}PtrInt(DstLine) + 3*(SrcRect.left + Offset.x));
          for x := SrcRect.left to SrcRect.right do
              begin
              {$IFDEF EnhancedRecordSupport}
              Dist:=Center.DistanceTo(T2DVector.create(x, y));
              {$ELSE}
              Dist:=Center.DistanceTo(x, y);
              {$ENDIF}
              if Dist >= (Radius-1) then
                 Move(SrcPtr^,DstPtr^,3);

              inc(SrcPtr,3);
              inc(DstPtr,3);
              end;
          end;
      ABitmap.LoadFromIntfImage(DestImg);
      SrcImg.Destroy;
      DestImg.Destroy;
    end;
   end;
end;

class procedure TGUITools.DrawAARoundCorner(ABitmap: TBitmap; Point: T2DIntVector;
  Radius: integer; CornerPos: TCornerPos; Color: TColor);
var
  CornerRect: T2DIntRect;
  Center: T2DIntVector;
  colorR, colorG, colorB: byte;
  x, y: integer;
  RadiusDist: double;
  OrgCornerRect: T2DIntRect;
  BitmapRect: T2DIntRect;
  cr, cg, cb: Byte;
begin
  if ABitmap.PixelFormat <> pf24bit then
    raise Exception.Create('TSpkGUITools.DrawAARoundCorner: Bitmapa musi byæ w trybie 24-bitowym!');

  // Sprawdzamy poprawnoϾ
  if Radius < 1 then
    exit;
  if (ABitmap.Width=0) or (ABitmap.Height=0) then
    exit;

  {$IFDEF EnhancedRecordSupport}
  // �?ród³owy rect...
  OrgCornerRect := T2DIntRect.Create(Point.x,
                                     Point.y,
                                     Point.x + radius - 1,
                                     Point.y + radius - 1);

  // ...przycinamy do rozmiarów bitmapy
  BitmapRect := T2DIntRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  {$ELSE}
  // �?ród³owy rect...
  OrgCornerRect.Create(Point.x,
                       Point.y,
                       Point.x + radius - 1,
                       Point.y + radius - 1);

  // ...przycinamy do rozmiarów bitmapy
  BitmapRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  {$ENDIF}

  if not BitmapRect.intersectsWith(OrgCornerRect, CornerRect) then
    exit;

  // Jeœli nie ma czego rysowaæ, wychodzimy
  if (CornerRect.Left > CornerRect.Right) or (CornerRect.Top > CornerRect.Bottom) then
    exit;

  // Szukamy œrodka ³uku - zale¿nie od rodzaju naro¿nika
  {$IFDEF EnhancedRecordSupport}
  case CornerPos of
    cpLeftTop:
      Center := T2DIntVector.Create(Point.x + radius - 1, Point.y + Radius - 1);
    cpRightTop:
      Center := T2DIntVector.Create(Point.x, Point.y + Radius - 1);
    cpLeftBottom:
      Center := T2DIntVector.Create(Point.x + radius - 1, Point.y);
    cpRightBottom:
      Center := T2DIntVector.Create(Point.x, Point.y);
  end;
  {$ELSE}
  case CornerPos of
    cpLeftTop:
      Center.Create(Point.x + radius - 1, Point.y + Radius - 1);
    cpRightTop:
      Center.Create(Point.x, Point.y + Radius - 1);
    cpLeftBottom:
      Center.Create(Point.x + radius - 1, Point.y);
    cpRightBottom:
      Center.Create(Point.x, Point.y);
  end;
  {$ENDIF}

  Color := ColorToRGB(Color);

  colorR := GetRValue(Color);
  colorG := GetGValue(Color);
  colorB := GetBValue(Color);

  for y := CornerRect.Top to CornerRect.Bottom do
  begin
    for x := CornerRect.Left to CornerRect.Right do
    begin
      {$IFDEF EnhancedRecordSupport}
      RadiusDist := 1 - abs((Radius - 1) - Center.DistanceTo(T2DIntVector.create(x, y)));
      {$ELSE}
      RadiusDist := 1 - abs((Radius - 1) - Center.DistanceTo(x, y));
      {$ENDIF}
      if RadiusDist > 0 then
      begin
        RedGreenBlue(ColorToRGB(ABitmap.Canvas.Pixels[x,y]), cr, cg, cb);
        cb := round(cb + (ColorB - cb) * RadiusDist);
        cg := round(cg + (ColorG - cg) * RadiusDist);
        cr := round(cr + (ColorR - cr) * RadiusDist);
        ABitmap.Canvas.Pixels[x,y] := RGBToColor(cr,cg,cb);
      end;
    end;
  end;
end;

class procedure TGUITools.DrawAARoundCorner(ABitmap: TBitmap;
  Point: T2DIntVector; Radius: integer; CornerPos: TCornerPos; Color: TColor;
  ClipRect: T2DIntRect);
var
  CornerRect: T2DIntRect;
  Center: T2DIntVector;
  colorR, colorG, colorB: byte;
  x, y: integer;
  RadiusDist: double;
  OrgCornerRect: T2DIntRect;
  UnClippedCornerRect : T2DIntRect;
  BitmapRect: T2DIntRect;
  cr,cb,cg: byte;
begin
  if ABitmap.PixelFormat<>pf24bit then
    raise Exception.Create('TSpkGUITools.DrawAARoundCorner: Bitmap must be in 24-bit mode!');

  if Radius < 1 then
    exit;
  if (ABitmap.Width = 0) or (ABitmap.Height = 0) then
    exit;

  {$IFDEF EnhancedRecordSupport}
  // Source rect...
  OrgCornerRect := T2DIntRect.Create(
    Point.x, Point.y, Point.x + radius - 1, Point.y + radius - 1
  );
  // ... cut to size bitmap
  BitmapRect := T2DIntRect.Create(
    0, 0, ABitmap.Width-1, ABitmap.Height-1);
  {$ELSE}
  // Source rect...
  OrgCornerRect.Create(Point.x,
                       Point.y,
                       Point.x + radius - 1,
                       Point.y + radius - 1);

  // ... cut to size bitmap
  BitmapRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  {$ENDIF}

  if not BitmapRect.IntersectsWith(OrgCornerRect, UnClippedCornerRect) then
    exit;

  // ClipRect
  if not UnClippedCornerRect.IntersectsWith(ClipRect, CornerRect) then
    exit;

  // If there is nothing to draw, we leave
  if (CornerRect.Left > CornerRect.Right) or
     (CornerRect.Top > CornerRect.Bottom)
  then
    exit;

  // We seek the center of the arc - depending on the type of corner
  {$IFDEF EnhancedRecordSupport}
  case CornerPos of
    cpLeftTop:
      Center := T2DIntVector.Create(Point.x + radius - 1, Point.y + Radius - 1);
    cpRightTop:
      Center := T2DIntVector.Create(Point.x, Point.y + Radius - 1);
    cpLeftBottom:
      Center := T2DIntVector.Create(Point.x + radius - 1, Point.y);
    cpRightBottom:
      Center := T2DIntVector.Create(Point.x, Point.y);
  end;
  {$ELSE}
  case CornerPos of
    cpLeftTop:
      Center.Create(Point.x + radius - 1, Point.y + Radius - 1);
    cpRightTop:
      Center.Create(Point.x, Point.y + Radius - 1);
    cpLeftBottom:
      Center.Create(Point.x + radius - 1, Point.y);
    cpRightBottom:
      Center.Create(Point.x, Point.y);
  end;
  {$ENDIF}

  Color := ColorToRGB(Color);

  colorR := GetRValue(Color);
  colorG := GetGValue(Color);
  colorB := GetBValue(Color);

  for y := CornerRect.Top to CornerRect.Bottom do
  begin
    for x := CornerRect.Left to CornerRect.Right do
    begin
      {$IFDEF EnhancedRecordSupport}
      RadiusDist := 1 - abs((Radius - 1) - Center.DistanceTo(T2DIntVector.create(x, y)));
      {$ELSE}
      RadiusDist := 1 - abs((Radius - 1) - Center.DistanceTo(x, y));
      {$ENDIF}
      if RadiusDist > 0 then
      begin
        RedGreenBlue(ColorToRGB(ABitmap.Canvas.Pixels[x,y]), cr, cg, cb);
        cb := round(cb + (ColorB - cb) * RadiusDist);
        cg := round(cg + (ColorG - cg) * RadiusDist);
        cr := round(cr + (ColorR - cr) * RadiusDist);
        ABitmap.Canvas.Pixels[x,y] := RGBToColor(cr,cg,cb);
      end;
    end;
  end;
end;

class procedure TGUITools.DrawAARoundCorner(ACanvas: TCanvas;
  Point: T2DIntVector; Radius: integer; CornerPos: TCornerPos; Color: TColor);
var
  Center: T2DIntVector;
  OrgColor: TColor;
  x, y: integer;
  RadiusDist: double;
  CornerRect: T2DIntRect;
begin
  if Radius<1 then
    exit;

  {$IFDEF EnhancedRecordSupport}
  // Source rect
  CornerRect := T2DIntRect.Create(
    Point.x, Point.y, Point.x + radius - 1, Point.y + radius - 1
  );
  // We seek the center of the arc - depending on the type of corner
  case CornerPos of
    cpLeftTop:
      Center := T2DIntVector.Create(Point.x + radius - 1, Point.y + Radius - 1);
    cpRightTop:
      Center := T2DIntVector.Create(Point.x, Point.y + Radius - 1);
    cpLeftBottom:
      Center := T2DIntVector.Create(Point.x + radius - 1, Point.y);
    cpRightBottom:
      Center := T2DIntVector.Create(Point.x, Point.y);
  end;
  {$ELSE}
  // Source rect
  CornerRect.Create(Point.x, Point.y, Point.x + radius - 1, Point.y + radius - 1);
  // We seek the center of the arc - depending on the type of corner
  case CornerPos of
    cpLeftTop:
      Center.Create(Point.x + radius - 1, Point.y + Radius - 1);
    cpRightTop:
      Center.Create(Point.x, Point.y + Radius - 1);
    cpLeftBottom:
      Center.Create(Point.x + radius - 1, Point.y);
    cpRightBottom:
      Center.Create(Point.x, Point.y);
  end;
  {$ENDIF}

  Color := ColorToRGB(Color);

  for y := CornerRect.Top to CornerRect.Bottom do
  begin
    for x := CornerRect.Left to CornerRect.Right do
    begin
      {$IFDEF EnhancedRecordSupport}
      RadiusDist := 1 - abs((Radius - 1) - Center.DistanceTo(T2DIntVector.Create(x, y)));
      {$ELSE}
      RadiusDist := 1 - abs((Radius - 1) - Center.DistanceTo(x, y));
      {$ENDIF}
      if RadiusDist > 0 then
      begin
        OrgColor := ACanvas.Pixels[x, y];
        ACanvas.Pixels[x, y] := TColorTools.Shade(OrgColor, Color, RadiusDist);
      end;
    end;
  end;
end;

class procedure TGUITools.DrawAARoundCorner(ACanvas: TCanvas;
  Point: T2DIntVector; Radius: integer; CornerPos: TCornerPos; Color: TColor;
  ClipRect: T2DIntRect);
var
  UseOrgClipRgn: boolean;
  ClipRgn: HRGN;
  OrgRgn: HRGN;
begin
  // Store the original ClipRgn and set a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(ClipRect.Left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);

  DrawAARoundCorner(ACanvas, Point, Radius, CornerPos, Color);

  // Restores previous ClipRgn and removes used regions
  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawAARoundFrame(ABitmap: TBitmap; Rect: T2DIntRect;
  Radius: integer; Color: TColor; ClipRect: T2DIntRect);
begin
  if ABitmap.PixelFormat <> pf24Bit then
   raise Exception.Create('TGUITools.DrawAARoundFrame: Bitmap must be in 24-bit mode!');

  if Radius < 1 then
    exit;

  if (Radius > Rect.Width div 2) or (Radius > Rect.Height div 2) then
    exit;

  // DrawAARoundCorner is protected against drawing outside the area
  {$IFDEF EnhancedRecordSupport}
  DrawAARoundCorner(ABitmap, T2DIntVector.Create(Rect.Left, Rect.Top), Radius, cpLeftTop, Color, ClipRect);
  DrawAARoundCorner(ABitmap, T2DIntVector.Create(Rect.Right - Radius + 1, Rect.Top), Radius, cpRightTop, Color, ClipRect);
  DrawAARoundCorner(ABitmap, T2DIntVector.Create(Rect.Left, Rect.Bottom - Radius + 1), Radius, cpLeftBottom, Color, ClipRect);
  DrawAARoundCorner(ABitmap, T2DIntVector.Create(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1), Radius, cpRightBottom, Color, ClipRect);
  {$ELSE}
  DrawAARoundCorner(ABitmap, Create2DIntVector(Rect.Left, Rect.Top), Radius, cpLeftTop, Color, ClipRect);
  DrawAARoundCorner(ABitmap, Create2DIntVector(Rect.Right - Radius + 1, Rect.Top), Radius, cpRightTop, Color, ClipRect);
  DrawAARoundCorner(ABitmap, Create2DIntVector(Rect.Left, Rect.Bottom - Radius + 1), Radius, cpLeftBottom, Color, ClipRect);
  DrawAARoundCorner(ABitmap, Create2DIntVector(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1), Radius, cpRightBottom, Color, ClipRect);
  {$ENDIF}

  ABitmap.Canvas.Pen.Color := Color;
  ABitmap.Canvas.pen.Style := psSolid;

  // Draw*Line is protected against drawing outside the area
  DrawVLine(ABitmap, Rect.Left, Rect.top + Radius, Rect.Bottom - Radius, Color, ClipRect);
  DrawVLine(ABitmap, Rect.Right, Rect.top + Radius, Rect.Bottom - Radius, Color, ClipRect);
  DrawHLine(ABitmap, Rect.Left + Radius, Rect.Right - Radius, Rect.Top, Color, ClipRect);
  DrawHLine(ABitmap, Rect.Left + Radius, Rect.Right - Radius, Rect.Bottom, Color, ClipRect);
end;

class procedure TGUITools.DrawAARoundFrame(ABitmap: TBitmap; Rect: T2DIntRect;
  Radius: integer; Color: TColor);
begin
  if ABitmap.PixelFormat <> pf24Bit then
    raise Exception.Create('TGUITools.DrawAARoundFrame: Bitmap must be in 24-bit mode!');

  if Radius < 1 then
    exit;

  if (Radius > Rect.Width div 2) or (Radius > Rect.Height div 2) then
    exit;

  // DrawAARoundCorner is protected against drawing outside the area
  {$IFDEF EnhancedRecordSupport}
  DrawAARoundCorner(ABitmap, T2DIntVector.Create(Rect.Left, Rect.Top), Radius, cpLeftTop, Color);
  DrawAARoundCorner(ABitmap, T2DIntVector.Create(Rect.Right - Radius + 1, Rect.Top), Radius, cpRightTop, Color);
  DrawAARoundCorner(ABitmap, T2DIntVector.Create(Rect.Left, Rect.Bottom - Radius + 1), Radius, cpLeftBottom, Color);
  DrawAARoundCorner(ABitmap, T2DIntVector.Create(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1), Radius, cpRightBottom, Color);
  {$ELSE}
  DrawAARoundCorner(ABitmap, Create2DIntVector(Rect.Left, Rect.Top), Radius, cpLeftTop, Color);
  DrawAARoundCorner(ABitmap, Create2DIntVector(Rect.Right - Radius + 1, Rect.top), Radius, cpRightTop, Color);
  DrawAARoundCorner(ABitmap, Create2DIntVector(Rect.Left, Rect.Bottom - Radius + 1), Radius, cpLeftBottom, Color);
  DrawAARoundCorner(ABitmap, Create2DIntVector(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1), Radius, cpRightBottom, Color);
  {$ENDIF}

  ABitmap.Canvas.Pen.Color := Color;
  ABitmap.Canvas.pen.Style := psSolid;

  // Draw*Line is protected against drawing outside the area
  DrawVLine(ABitmap, Rect.Left, Rect.Top + Radius, Rect.bottom - Radius, Color);
  DrawVLine(ABitmap, Rect.Right, Rect.Top + Radius, Rect.bottom - Radius, Color);
  DrawHLine(ABitmap, Rect.Left + Radius, Rect.Right - Radius, Rect.Top, Color);
  DrawHLine(ABitmap, Rect.Left + Radius, Rect.Right - Radius, Rect.Bottom, Color);
end;

class procedure TGUITools.DrawFitWText(ABitmap: TBitmap; x1, x2, y: integer;
  const AText: string; TextColor: TColor; Align : TAlignment);
var
  tw: integer;
  s: string;
begin
  with ABitmap.Canvas do
  begin
    Font.Color := TextColor;
    s := AText;
    tw := TextWidth(s);
    if tw <= x2-x1+1 then
    case Align of
      taLeftJustify  : TextOut(x1,y,AText);
      taRightJustify : TextOut(x2-tw+1,y,AText);
      taCenter       : TextOut(x1 + ((x2-x1 - tw) div 2), y, AText);
    end else
    begin
      while (s <> '') and (tw > x2-x1+1) do
      begin
        Delete(s, Length(s), 1);
        tw := TextWidth(s+'...');
      end;
      if tw <= x2-x1+1 then
        TextOut(x1, y, s+'...');
    end;
  end;
end;

class procedure TGUITools.DrawHLine(ACanvas: TCanvas; x1, x2, y: integer;
  Color: TColor);
begin
  EnsureOrder(x1, x2);
  ACanvas.Pen.Color := Color;
  ACanvas.MoveTo(x1, y);
  ACanvas.LineTo(x2+1,y);
end;

class procedure TGUITools.DrawHLine(ACanvas: TCanvas; x1, x2, y: integer;
  Color: TColor; ClipRect: T2DIntRect);
var
  UseOrgClipRgn: boolean;
  ClipRgn: HRGN;
  OrgRgn: HRGN;
begin
  // Store the original ClipRgn and set a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);

  DrawHLine(ACanvas, x1, x2, y, Color);

  // Restores previous ClipRgn and removes used regions
  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TImageList;
  ImageIndex: integer; Point : T2DIntVector; ClipRect: T2DIntRect);
begin
  DrawImage(ABitmap.Canvas, ImageList, ImageIndex, Point, ClipRect);
end;

class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TImageList;
  ImageIndex: integer; Point: T2DIntVector);
begin
  DrawImage(ABitmap.Canvas, ImageList, ImageIndex, Point);
end;

class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList;
  ImageIndex: integer; Point : T2DIntVector; ClipRect: T2DIntRect);
var
  UseOrgClipRgn: Boolean;
  OrgRgn: HRGN;
  ClipRgn: HRGN;
  //ImageIcon: TIcon;  // wp: no longer needed -- see below
  ImageBitmap: TBitmap;
begin
  // Storing original ClipRgn and applying a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);
  ImageList.Draw(ACanvas, Point.X, Point.Y, ImageIndex);

  (*
  { wp: Next part fixes issue https://sourceforge.net/p/lazarus-ccr/bugs/35/ }
  ImageBitmap := TBitmap.Create;
  ImageList.GetBitmap(ImageIndex, ImageBitmap);
  ACanvas.Draw(Point.x, Point.y, ImageBitmap);
  ImageBitmap.Free;
    *)

{ wp: The following lines were removed and replaced by the "ImageBitmap" lines
  above in order to fix the "handle leak" of
  https://sourceforge.net/p/lazarus-ccr/bugs/35/
  Not daring to touch the ImageList.Draw which would have worked as well. }
(*
  // avoid exclusive draw. draw with local canvas itself.
  //ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex);
  {$IfDef LCLWin32}
  ImageIcon := TIcon.Create;
  ImageList.GetIcon(ImageIndex, ImageIcon);
  ACanvas.Draw(Point.x, Point.y, ImageIcon);
  ImageIcon.Free;
  {$Else}
  ImageBitmap := TBitmap.Create;
  ImageList.GetBitmap(ImageIndex, ImageBitmap);
  ACanvas.Draw(Point.x, Point.y, ImageBitmap);
  ImageBitmap.Free;
  {$EndIf}
*)
  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList;
  ImageIndex: integer; Point : T2DIntVector; ClipRect: T2DIntRect;
  AImageWidthAt96PPI, ATargetPPI: Integer; ACanvasFactor: Double);
var
  UseOrgClipRgn: Boolean;
  OrgRgn: HRGN;
  ClipRgn: HRGN;
  //ImageIcon: TIcon;  // wp: no longer needed -- see below
  ImageBitmap: TBitmap;
begin
  // Storing original ClipRgn and applying a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);

  {$IF LCL_FULLVERSION >= 1090000}
  ImageList.DrawForPPI(ACanvas, Point.X, Point.Y, ImageIndex,
    AImageWidthAt96PPI, ATargetPPI, ACanvasFactor);
  {$ELSE}
  ImageList.Draw(ACanvas, Point.X, Point.Y, ImageIndex);
  {$ENDIF}

  (*
  { wp: Next part fixes issue https://sourceforge.net/p/lazarus-ccr/bugs/35/ }
  ImageBitmap := TBitmap.Create;
  ImageList.GetBitmap(ImageIndex, ImageBitmap);
  ACanvas.Draw(Point.x, Point.y, ImageBitmap);
  ImageBitmap.Free;
    *)

{ wp: The following lines were removed and replaced by the "ImageBitmap" lines
  above in order to fix the "handle leak" of
  https://sourceforge.net/p/lazarus-ccr/bugs/35/
  Not daring to touch the ImageList.Draw which would have worked as well. }
(*
  // avoid exclusive draw. draw with local canvas itself.
  //ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex);
  {$IfDef LCLWin32}
  ImageIcon := TIcon.Create;
  ImageList.GetIcon(ImageIndex, ImageIcon);
  ACanvas.Draw(Point.x, Point.y, ImageIcon);
  ImageIcon.Free;
  {$Else}
  ImageBitmap := TBitmap.Create;
  ImageList.GetBitmap(ImageIndex, ImageBitmap);
  ACanvas.Draw(Point.x, Point.y, ImageBitmap);
  ImageBitmap.Free;
  {$EndIf}
*)
  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;


class procedure TGUITools.DrawMarkedText(ACanvas: TCanvas; x, y: integer; const AText,
  AMarkPhrase: string; TextColor : TColor; ClipRect: T2DIntRect; CaseSensitive: boolean);
var
  UseOrgClipRgn: Boolean;
  OrgRgn: HRGN = 0;
  ClipRgn: HRGN = 0;
begin
  // Store the original ClipRgn and set a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);

  DrawMarkedText(ACanvas, x, y, AText, AMarkPhrase, TextColor, CaseSensitive);

  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawMarkedText(ACanvas: TCanvas; x, y: integer; const AText,
  AMarkPhrase: string; TextColor : TColor; CaseSensitive : boolean);
var
  TextToDraw: string;
  BaseText: string;
  MarkText: string;
  MarkPos: Integer;
  x1: integer;
  s: string;
  MarkTextLength: Integer;
begin
  TextToDraw := AText;
  if CaseSensitive then
  begin
    BaseText := AText;
    MarkText := AMarkPhrase;
  end else
  begin
    BaseText := AnsiUpperCase(AText);
    MarkText := AnsiUpperCase(AMarkPhrase);
  end;

  x1 := x;
  MarkTextLength := Length(MarkText);

  ACanvas.Font.Color := TextColor;
  ACanvas.Brush.Style := bsClear;

  MarkPos := pos(MarkText, BaseText);
  while MarkPos > 0 do
  begin
    if MarkPos > 1 then
    begin
      // Drawing text before highlighted
      ACanvas.Font.Style := ACanvas.Font.Style - [fsBold];
      s := copy(TextToDraw, 1, MarkPos-1);

      ACanvas.TextOut(x1, y, s);
      inc(x1, ACanvas.TextWidth(s)+1);

      Delete(TextToDraw, 1, MarkPos-1);
      Delete(BaseText, 1, MarkPos-1);
    end;

    // Drawing highlighted text
    ACanvas.Font.Style := ACanvas.Font.Style + [fsBold];
    s := copy(TextToDraw, 1, MarkTextLength);

    ACanvas.TextOut(x1, y, s);
    inc(x1, ACanvas.TextWidth(s)+1);

    Delete(TextToDraw, 1, MarkTextLength);
    Delete(BaseText, 1, MarkTextLength);

    MarkPos := pos(MarkText, BaseText);
  end;

  if Length(BaseText) > 0 then
  begin
    ACanvas.Font.Style := ACanvas.Font.Style - [fsBold];
    ACanvas.TextOut(x1, y, TextToDraw);
  end;
end;

class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList;
  ImageIndex: integer; Point: T2DIntVector);
begin
  ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex);
end;

class procedure TGUITools.DrawOutlinedText(ACanvas: TCanvas; x, y: integer;
  const AText: string; TextColor, OutlineColor: TColor);
begin
  with ACanvas do
  begin
    Brush.Style := bsClear;
    Font.Color := OutlineColor;
    TextOut(x-1, y-1, AText);
    TextOut(x, y-1, AText);
    TextOut(x+1, y-1, AText);
    TextOut(x-1, y, AText);
    TextOut(x+1, y, AText);
    TextOut(x-1, y+1, AText);
    TextOut(x, y+1, AText);
    TextOut(x+1, y+1, AText);

    Font.Color := TextColor;
    TextOut(x, y, AText);
  end;
end;

class procedure TGUITools.DrawOutlinedText(ACanvas: TCanvas; x, y: integer;
  const AText: string; TextColor, OutlineColor: TColor; ClipRect: T2DIntRect);
var
  WinAPIClipRect: TRect;
begin
  WinAPIClipRect := ClipRect.ForWinAPI;
  with ACanvas do
  begin
    Brush.Style := bsClear;
    Font.Color := OutlineColor;
    TextRect(WinAPIClipRect, x-1, y-1, AText);
    TextRect(WinAPIClipRect, x, y-1, AText);
    TextRect(WinAPIClipRect, x+1, y-1, AText);
    TextRect(WinAPIClipRect, x-1, y, AText);
    TextRect(WinAPIClipRect, x+1, y, AText);
    TextRect(WinAPIClipRect, x-1, y+1, AText);
    TextRect(WinAPIClipRect, x, y+1, AText);
    TextRect(WinAPIClipRect, x+1, y+1, AText);

    Font.Color := TextColor;
    TextRect(WinAPIClipRect, x, y, AText);
  end;
end;

class procedure TGUITools.DrawHLine(ABitmap: TBitmap; x1, x2, y: integer;
  Color: TColor);
var
  LineRect: T2DIntRect;
  BitmapRect: T2DIntRect;
begin
  if ABitmap.PixelFormat <> pf24Bit then
    raise Exception.Create('TGUITools.DrawHLine: Bitmap must be in 24-bit mode');
  EnsureOrder(x1, x2);

  {$IFDEF EnhancedRecordSupport}
  BitmapRect := T2DIntRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not BitmapRect.IntersectsWith(T2DIntRect.Create(x1, y, x2, y), LineRect) then
    exit;
  {$ELSE}
  BitmapRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not BitmapRect.IntersectsWith(Create2DIntRect(x1, y, x2, y), LineRect) then
    exit;
  {$ENDIF}

  ABitmap.Canvas.Pen.Color := Color;
  ABitmap.Canvas.Pen.Style := psSolid;
  ABitmap.Canvas.MoveTo(LineRect.Left, LineRect.Top);
  ABitmap.canvas.LineTo(LineRect.Right+1, LineRect.Top);
end;

class procedure TGUITools.DrawHLine(ABitmap: TBitmap; x1, x2, y: integer;
  Color: TColor; ClipRect: T2DIntRect);
var
  OrgLineRect: T2DIntRect;
  LineRect: T2DIntRect;
  BitmapRect: T2DIntRect;
begin
  if ABitmap.PixelFormat<>pf24bit then
    raise Exception.Create('TGUITools.DrawHLine: Bitmap must be in 24-bit mode!');
  EnsureOrder(x1, x2);

  {$IFDEF EnhancedRecordSupport}
  BitmapRect := T2DIntRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not BitmapRect.IntersectsWith(T2DIntRect.Create(x1, y, x2, y), OrgLineRect) then
    exit;
  {$ELSE}
  BitmapRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not BitmapRect.IntersectsWith(Create2DIntRect(x1, y, x2, y), OrgLineRect) then
    exit;
  {$ENDIF}

  if not OrgLineRect.IntersectsWith(ClipRect, LineRect) then
    exit;

  ABitmap.Canvas.Pen.Color := Color;
  ABitmap.Canvas.Pen.Style := psSolid;
  ABitmap.Canvas.MoveTo(LineRect.Left, LineRect.Top);
  ABitmap.Canvas.LineTo(LineRect.Right+1, LineRect.Top);
end;

class procedure TGUITools.DrawOutlinedText(ABitmap: TBitmap; x, y: integer;
  const AText: string; TextColor, OutlineColor: TColor; ClipRect: T2DIntRect);
var
  WinAPIClipRect: TRect;
begin
  WinAPIClipRect := ClipRect.ForWinAPI;
  with ABitmap.canvas do
  begin
    Brush.Style := bsClear;
    Font.Color := OutlineColor;
    TextRect(WinAPIClipRect, x-1, y-1, AText);
    TextRect(WinAPIClipRect, x, y-1, AText);
    TextRect(WinAPIClipRect, x+1, y-1, AText);
    TextRect(WinAPIClipRect, x-1, y, AText);
    TextRect(WinAPIClipRect, x+1, y, AText);
    TextRect(WinAPIClipRect, x-1, y+1, AText);
    TextRect(WinAPIClipRect, x, y+1, AText);
    TextRect(WinAPIClipRect, x+1, y+1, AText);

    Font.Color := TextColor;
    TextRect(WinAPIClipRect, x, y, AText);
  end;
end;

class procedure TGUITools.DrawRegion(ACanvas: TCanvas; Region: HRGN;
  Rect : T2DIntRect; ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind);
var
  UseOrgClipRgn: Boolean;
  OrgRgn: HRGN;
begin
  // Store the original ClipRgn and set a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  SelectClipRgn(ACanvas.Handle, Region);

  FillGradientRectangle(ACanvas, Rect, ColorFrom, ColorTo, GradientKind);

  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
end;

class procedure TGUITools.DrawRegion(ACanvas: TCanvas; Region: HRGN;
  Rect : T2DIntRect; ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind;
  ClipRect: T2DIntRect);
var
  UseOrgClipRgn: boolean;
  ClipRgn: HRGN;
  OrgRgn: HRGN;
begin
  // Store the original ClipRgn and set a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);

  DrawRegion(ACanvas, Region, Rect, ColorFrom, ColorTo, GradientKind);

  // Restores previous ClipRgn and removes used regions
  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawRoundRect(ACanvas: TCanvas; Rect: T2DIntRect;
  Radius: integer; ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind;
  ClipRect: T2DIntRect; LeftTopRound, RightTopRound, LeftBottomRound,
  RightBottomRound: boolean);
var
  UseOrgClipRgn: boolean;
  ClipRgn: HRGN;
  OrgRgn: HRGN;
begin
  // Store the original ClipRgn and set a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(
    ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1
  );
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);

  DrawRoundRect(ACanvas, Rect, Radius, ColorFrom, ColorTo, GradientKind,
    LeftTopRound, RightTopRound, LeftBottomRound, RightBottomRound);

  // Restores previous ClipRgn and removes used regions
  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawText(ACanvas: TCanvas; x, y: integer;
  const AText: string; TextColor: TColor);
begin
  with ACanvas do
  begin
    Brush.Style := bsClear;
    Font.Color := TextColor;
    TextOut(x, y, AText);
  end;
end;

class procedure TGUITools.DrawText(ACanvas: TCanvas; x, y: integer;
  const AText: string; TextColor: TColor; ClipRect: T2DIntRect);
var
  WinAPIClipRect: TRect;
begin
  WinAPIClipRect := ClipRect.ForWinAPI;
  with ACanvas do
  begin
    Brush.Style := bsClear;
    Font.Color := TextColor;
    TextRect(WinAPIClipRect, x, y, AText);
  end;
end;

class procedure TGUITools.DrawRoundRect(ACanvas: TCanvas; Rect: T2DIntRect;
  Radius: integer; ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind;
  LeftTopRound, RightTopRound, LeftBottomRound, RightBottomRound: boolean);
var
  RoundRgn: HRGN;
  TmpRgn: HRGN;
  OrgRgn: HRGN;
  UseOrgClipRgn: Boolean;
begin
  if Radius < 0 then
    exit;

  if Radius > 0 then
  begin
    //WriteLn('Radius: ', Radius, ' Rect.Width: ', Rect.Width, ' Rect.Height: ', Rect.Height);

    // There's a bug in fpc that evaluates the expression below erroneous when using inline
    // Radius = 3 and Rect.Width >= 128 and <= 261 will evaluate to true
    {$ifdef FpcBugWorkAround}
    if (CompareValue(Radius*2, Rect.width) > 0) and (CompareValue(Radius*2, Rect.Height) > 0) then
      exit;
    {$else}
    if (Radius*2 > Rect.Width) or (Radius*2 > Rect.Height) then
      exit;
    {$endif}

    // Zapamiêtywanie oryginalnego ClipRgn i ustawianie nowego
    SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

    if not(LeftTopRound) and
       not(RightTopRound) and
       not(LeftBottomRound) and
       not (RightBottomRound) then
    begin
      RoundRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Right + 1, Rect.Bottom + 1);
    end
    else
    begin
      RoundRgn := CreateRoundRectRgn(Rect.Left, Rect.Top, Rect.Right +2, Rect.Bottom + 2, Radius*2, Radius*2);

      if not LeftTopRound then
      begin
        TmpRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Left + Radius, Rect.Top + Radius);
        CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR);
        DeleteObject(TmpRgn);
      end;

      if not RightTopRound then
      begin
        TmpRgn := CreateRectRgn(Rect.Right - Radius + 1, Rect.Top, Rect.Right + 1, Rect.Top + Radius);
        CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR);
        DeleteObject(TmpRgn);
      end;

      if not LeftBottomRound then
      begin
        TmpRgn := CreateRectRgn(Rect.Left, Rect.Bottom - Radius + 1, Rect.Left + Radius, Rect.Bottom + 1);
        CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR);
        DeleteObject(TmpRgn);
      end;

      if not RightBottomRound then
      begin
        TmpRgn := CreateRectRgn(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1, Rect.Right + 1, Rect.Bottom + 1);
        CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR);
        DeleteObject(TmpRgn);
      end;
    end;

    if UseOrgClipRgn then
      CombineRgn(RoundRgn, RoundRgn, OrgRgn, RGN_AND);

    SelectClipRgn(ACanvas.Handle, RoundRgn);
  end;  // if Radius > 0

  ColorFrom := ColorToRGB(ColorFrom);
  ColorTo := ColorToRGB(ColorTo);

  FillGradientRectangle(ACanvas, Rect, ColorFrom, ColorTo, GradientKind);

  if Radius > 0 then
  begin
    // Restores previous ClipRgn and removes used regions
    RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
    DeleteObject(RoundRgn);
  end;
end;

class procedure TGUITools.DrawOutlinedText(ABitmap: TBitmap; x, y: integer;
  const AText: string; TextColor, OutlineColor: TColor);
begin
  with ABitmap.Canvas do
  begin
    Brush.Style := bsClear;
    Font.Color := OutlineColor;
    TextOut(x-1, y-1, AText);
    TextOut(x, y-1, AText);
    TextOut(x+1, y-1, AText);
    TextOut(x-1, y, AText);
    TextOut(x+1, y, AText);
    TextOut(x-1, y+1, AText);
    TextOut(x, y+1, AText);
    TextOut(x+1, y+1, AText);

    Font.Color := TextColor;
    TextOut(x, y, AText);
  end;
end;

class procedure TGUITools.DrawText(ABitmap: TBitmap; x, y: integer;
  const AText: string; TextColor: TColor; ClipRect: T2DIntRect);
var
  WinAPIClipRect : TRect;
begin
  WinAPIClipRect := ClipRect.ForWinAPI;
  with ABitmap.Canvas do
  begin
    Brush.Style := bsClear;
    Font.Color := TextColor;
    TextRect(WinAPIClipRect, x, y, AText);
  end;
end;

class procedure TGUITools.DrawFitWOutlinedText(ABitmap: TBitmap;
  x1, x2, y: integer; const AText: string; TextColor, OutlineColor: TColor;
  Align: TAlignment);
var
  tw: integer;
  s: string;
begin
  with ABitmap.Canvas do
  begin
    s := AText;
    tw := TextWidth(s) + 2;
    if tw <= x2 - x1 + 1 then
      case Align of
        taLeftJustify:
          TGUITools.DrawOutlinedText(ABitmap,x1, y, AText, TextColor, OutlineColor);
        taRightJustify:
          TGUITools.DrawOutlinedText(ABitmap,x2-tw+1, y, AText, TextColor, OutlineColor);
        taCenter:
          TGUITools.DrawOutlinedText(ABitmap,x1 + ((x2-x1 - tw) div 2), y, AText, TextColor, OutlineColor);
      end
    else
    begin
      while (s <> '') and (tw > x2 - x1 + 1) do
      begin
        Delete(s, Length(s), 1);
        tw := TextWidth(s + '...') + 2;
      end;
      if tw <= x2 - x1 + 1 then
        TGUITools.DrawOutlinedText(ABitmap, x1, y, s+'...', TextColor, OutlineColor);
    end;
  end;
end;

class procedure TGUITools.DrawFitWOutlinedText(ACanvas: TCanvas;
  x1, x2, y: integer; const AText: string; TextColor, OutlineColor: TColor;
  Align: TAlignment);
var
  tw: integer;
  s: string;
begin
  with ACanvas do
  begin
    s := AText;
    tw := TextWidth(s) + 2;
    if tw <= x2 - x1 + 1 then
      case Align of
        taLeftJustify:
          TGUITools.DrawOutlinedText(ACanvas,x1, y, AText, TextColor, OutlineColor);
        taRightJustify:
          TGUITools.DrawOutlinedText(ACanvas,x2-tw+1, y, AText, TextColor, OutlineColor);
        taCenter:
          TGUITools.DrawOutlinedText(ACanvas,x1 + (x2-x1 - tw) div 2, y, AText, TextColor, OutlineColor);
       end
    else
    begin
      while (s <> '') and (tw > x2 - x1 + 1) do
      begin
        Delete(s, Length(s), 1);
        tw := TextWidth(s + '...') + 2;
      end;
      if tw <= x2 - x1 + 1 then
        TGUITools.DrawOutlinedText(ACanvas, x1, y, s+'...', TextColor, OutlineColor);
    end;
  end;
end;

class procedure TGUITools.FillGradientRectangle(ACanvas: TCanvas;
  Rect: T2DIntRect; ColorFrom: TColor; ColorTo: TColor;
  GradientKind: TBackgroundKind);
var
  Mesh: array of GRADIENTRECT;
  GradientVertice: array of TRIVERTEX;
  ConcaveColor: TColor;
begin
  case GradientKind of
    bkSolid:
      begin
        ACanvas.Brush.Style := bsSolid;
        ACanvas.brush.color := ColorFrom;
        ACanvas.fillrect(Rect.ForWinAPI);
      end;
    bkVerticalGradient, bkHorizontalGradient:
      begin
        SetLength(GradientVertice, 2);
        with GradientVertice[0] do
        begin
          x := Rect.left;
          y := Rect.top;
          Red := GetRValue(ColorFrom) shl 8;
          Green := GetGValue(ColorFrom) shl 8;
          Blue := GetBValue(ColorFrom) shl 8;
          Alpha := 255 shl 8;
        end;
        with GradientVertice[1] do
        begin
          x := Rect.Right + 1;
          y := Rect.bottom + 1;
          Red := GetRValue(ColorTo) shl 8;
          Green := GetGValue(ColorTo) shl 8;
          Blue := GetBValue(ColorTo) shl 8;
          Alpha := 255 shl 8;
        end;
        SetLength(Mesh, 1);
        Mesh[0].UpperLeft := 0;
        Mesh[0].LowerRight := 1;
        if GradientKind = bkVerticalGradient then
          GradientFill(ACanvas.Handle, @GradientVertice[0], 2, @Mesh[0], 1, GRADIENT_FILL_RECT_V)
        else
          GradientFill(ACanvas.Handle, @GradientVertice[0], 2, @Mesh[0], 1, GRADIENT_FILL_RECT_H);
      end;
    bkConcave:
      begin
        ConcaveColor:=TColorTools.Brighten(ColorFrom, 20);
        SetLength(GradientVertice, 4);
        with GradientVertice[0] do
        begin
          x := Rect.left;
          y := Rect.top;
          Red := GetRValue(ColorFrom) shl 8;
          Green := GetGValue(ColorFrom) shl 8;
          Blue := GetBValue(ColorFrom) shl 8;
          Alpha := 255 shl 8;
        end;
        with GradientVertice[1] do
        begin
          x := Rect.Right + 1;
          y := Rect.Top + (Rect.height) div 4;
          Red := GetRValue(ConcaveColor) shl 8;
          Green := GetGValue(ConcaveColor) shl 8;
          Blue := GetBValue(ConcaveColor) shl 8;
          Alpha := 255 shl 8;
        end;
        with GradientVertice[2] do
        begin
          x := Rect.left;
          y := Rect.Top + (Rect.height) div 4;
          Red := GetRValue(ColorTo) shl 8;
          Green := GetGValue(ColorTo) shl 8;
          Blue := GetBValue(ColorTo) shl 8;
          Alpha := 255 shl 8;
        end;
        with GradientVertice[3] do
        begin
          x := Rect.Right + 1;
          y := Rect.bottom + 1;
          Red := GetRValue(ColorFrom) shl 8;
          Green := GetGValue(ColorFrom) shl 8;
          Blue := GetBValue(ColorFrom) shl 8;
          Alpha := 255 shl 8;
        end;
        SetLength(Mesh, 2);
        Mesh[0].UpperLeft := 0;
        Mesh[0].LowerRight := 1;
        Mesh[1].UpperLeft := 2;
        Mesh[1].LowerRight := 3;
        GradientFill(ACanvas.Handle, @GradientVertice[0], 4, @Mesh[0], 2, GRADIENT_FILL_RECT_V);
      end;
  end;
end;

class procedure TGUITools.DrawFitWText(ACanvas: TCanvas; x1, x2, y: integer;
  const AText: string; TextColor: TColor; Align: TAlignment);
var
  tw: integer;
  s: string;
begin
  with ACanvas do
  begin
    Font.Color := TextColor;
    s := AText;
    tw := TextWidth(s);
    // We draw if the text is changed
    if tw <= x2 - x1 + 1 then
      case Align of
        taLeftJustify  : TextOut(x1, y, AText);
        taRightJustify : TextOut(x2-tw+1, y, AText);
        taCenter       : TextOut(x1 + (x2-x1 - tw) div 2, y, AText);
      end
    else
    begin
      while (s <> '') and (tw > x2 - x1 + 1) do
      begin
        Delete(s, Length(s), 1);
        tw := TextWidth(s + '...');
      end;
      if tw <= x2 - x1 + 1 then
        TextOut(x1, y, s + '...');
    end;
  end;
end;

class procedure TGUITools.RenderBackground(ABuffer: TBitmap;
  Rect: T2DIntRect; Color1, Color2: TColor; BackgroundKind: TBackgroundKind);
var
  TempRect: T2DIntRect;
begin
  if ABuffer.PixelFormat<>pf24bit then
    raise Exception.Create('TGUITools.RenderBackground: Bitmap must be in 24-bit mode');
  if (Rect.Left > Rect.Right) or (Rect.Top > Rect.Bottom) then
    exit;

  // Both the FillRect method and the WinAPI gradient drawing are
  // protected from drawing outside the canvas area.
  case BackgroundKind of
    bkSolid:
      begin
        ABuffer.Canvas.Brush.Color := Color1;
        ABuffer.Canvas.Brush.Style := bsSolid;
        ABuffer.Canvas.FillRect(Rect.ForWinAPI);
      end;
    bkVerticalGradient:
      TGradientTools.VGradient(ABuffer.Canvas, Color1, Color2, Rect.ForWinAPI);
    bkHorizontalGradient:
      TGradientTools.HGradient(ABuffer.Canvas, Color1, Color2, Rect.ForWinAPI);
   bkConcave:
     begin
       {$IFDEF EnhancedRecordSupport}
       TempRect := T2DIntRect.Create(
       {$ELSE}
       TempRect.Create(
       {$ENDIF}
         Rect.Left, Rect.Top, Rect.Right, Rect.Top + (Rect.Bottom - Rect.Top) div 4
       );
       TGradientTools.VGradient(ABuffer.Canvas, Color1, TColorTools.Shade(Color1, Color2, 20), TempRect.ForWinAPI);
       {$IFDEF EnhancedRecordSupport}
       TempRect := T2DIntRect.Create(
       {$ELSE}
       TempRect.Create(
       {$ENDIF}
         Rect.Left, Rect.Top + (Rect.Bottom - Rect.Top) div 4 + 1, Rect.Right, Rect.Bottom
       );
       TGradientTools.VGradient(ABuffer.Canvas, Color2, Color1, TempRect.ForWinAPI);
     end;
  end;  // case
end;

class procedure TGUITools.RestoreClipRgn(DC: HDC; OrgRgnExists: boolean;
  var OrgRgn: HRGN);
begin
  if OrgRgnExists then
    SelectClipRgn(DC, OrgRgn) else
    SelectClipRgn(DC, 0);
  DeleteObject(OrgRgn);
end;

class procedure TGUITools.SaveClipRgn(DC: HDC; out OrgRgnExists: boolean;
  out OrgRgn: HRGN);
var
  i: integer;
begin
  OrgRgn := CreateRectRgn(0, 0, 1, 1);
  i := GetClipRgn(DC, OrgRgn);
  OrgRgnExists := (i=1);
end;

class procedure TGUITools.DrawText(ABitmap: TBitmap; x, y: integer; const AText: string;
  TextColor: TColor);
begin
  with ABitmap.Canvas do
  begin
    Brush.Style := bsClear;
    Font.Color:= TextColor;
    TextOut(x, y, AText);
  end;
end;

class procedure TGUITools.DrawVLine(ABitmap: TBitmap; x, y1, y2: integer;
  Color: TColor);
var
  LineRect: T2DIntRect;
  BitmapRect: T2DIntRect;
begin
  if ABitmap.PixelFormat <> pf24bit then
    raise Exception.Create('TGUITools.DrawHLine: Bitmap must be in 24-bit mode!');

  EnsureOrder(y1, y2);

  {$IFDEF EnhancedRecordSupport}
  BitmapRect := T2DIntRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not (BitmapRect.IntersectsWith(T2DIntRect.Create(x, y1, x, y2), LineRect)) then
    exit;
  {$ELSE}
  BitmapRect.create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not (BitmapRect.IntersectsWith(Create2DIntRect(x, y1, x, y2), LineRect)) then
    exit;
  {$ENDIF}

  ABitmap.Canvas.Pen.color := Color;
  ABitmap.Canvas.Pen.style := psSolid;
  ABitmap.Canvas.Moveto(LineRect.Left, LineRect.Top);
  ABitmap.Canvas.Lineto(LineRect.Left, Linerect.Bottom+1);
end;

class procedure TGUITools.DrawVLine(ABitmap: TBitmap; x, y1, y2: integer;
  Color: TColor; ClipRect: T2DIntRect);
var
  OrgLineRect: T2DIntRect;
  LineRect: T2DIntRect;
  BitmapRect: T2DIntRect;
begin
  if ABitmap.PixelFormat <> pf24bit then
    raise Exception.Create('TGUITools.DrawHLine: Bitmap must be in 24-bit mode!');

  EnsureOrder(y1, y2);

  {$IFDEF EnhancedRecordSupport}
  BitmapRect := T2DIntRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not(BitmapRect.IntersectsWith(T2DIntRect.Create(x, y1, x, y2), OrgLineRect)) then
    exit;
  {$ELSE}
  BitmapRect.Create(0, 0, ABitmap.Width-1, ABitmap.Height-1);
  if not(BitmapRect.IntersectsWith(Create2DIntRect(x, y1, x, y2), OrgLineRect)) then
    exit;
  {$ENDIF}

  if not(OrgLineRect.IntersectsWith(ClipRect, LineRect)) then
    exit;

  ABitmap.Canvas.Pen.Color := Color;
  ABitmap.Canvas.Pen.Style := psSolid;
  ABitmap.Canvas.Moveto(LineRect.Left, LineRect.Top);
  ABitmap.Canvas.Lineto(LineRect.Left, Linerect.Bottom+1);
end;

class procedure TGUITools.DrawVLine(ACanvas: TCanvas; x, y1, y2: integer;
  Color: TColor);
begin
  EnsureOrder(y1, y2);
  ACanvas.Pen.Color := Color;
  ACanvas.Moveto(x, y1);
  ACanvas.Lineto(x, y2+1);
end;

class procedure TGUITools.DrawVLine(ACanvas: TCanvas; x, y1, y2: integer;
  Color: TColor; ClipRect: T2DIntRect);
var
  UseOrgClipRgn: boolean;
  ClipRgn: HRGN;
  OrgRgn: HRGN;
begin
  // Store the original ClipRgn and set a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);

  DrawVLine(ACanvas, x, y1, y2, Color);

  // Restores previous ClipRgn and removes used regions
  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawAARoundFrame(ACanvas: TCanvas; Rect: T2DIntRect;
  Radius: integer; Color: TColor);
begin
  if Radius < 1 then
    exit;

  if (Radius > Rect.Width div 2) or (Radius > Rect.Height div 2) then
    exit;

  // DrawAARoundCorner is protected against drawing outside the area
  {$IFDEF EnhancedRecordSupport}
  DrawAARoundCorner(ACanvas, T2DIntVector.create(Rect.Left, Rect.Top), Radius, cpLeftTop, Color);
  DrawAARoundCorner(ACanvas, T2DIntVector.create(Rect.Right - Radius + 1, Rect.Top), Radius, cpRightTop, Color);
  DrawAARoundCorner(ACanvas, T2DIntVector.create(Rect.Left, Rect.Bottom - Radius + 1), Radius, cpLeftBottom, Color);
  DrawAARoundCorner(ACanvas, T2DIntVector.create(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1), Radius, cpRightBottom, Color);
  {$ELSE}
  DrawAARoundCorner(ACanvas, Create2DIntVector(Rect.Left, Rect.Top), Radius, cpLeftTop, Color);
  DrawAARoundCorner(ACanvas, Create2DIntVector(Rect.Right - Radius + 1, Rect.Top), Radius, cpRightTop, Color);
  DrawAARoundCorner(ACanvas, Create2DIntVector(Rect.Left, Rect.Bottom - Radius + 1), Radius, cpLeftBottom, Color);
  DrawAARoundCorner(ACanvas, Create2DIntVector(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1), Radius, cpRightBottom, Color);
  {$ENDIF}

  ACanvas.Pen.color := Color;
  ACanvas.pen.style := psSolid;

  // Draw * Line is protected against drawing outside the area
  DrawVLine(ACanvas, Rect.Left, Rect.Top + Radius, Rect.Bottom - Radius, Color);
  DrawVLine(ACanvas, Rect.Right, Rect.Top + Radius, Rect.Bottom - Radius, Color);
  DrawHLine(ACanvas, Rect.Left + Radius, Rect.Right - Radius, Rect.Top, Color);
  DrawHLine(ACanvas, Rect.Left + Radius, Rect.Right - Radius, Rect.Bottom, Color);
end;

class procedure TGUITools.DrawAARoundFrame(ACanvas: TCanvas; Rect: T2DIntRect;
  Radius: integer; Color: TColor; ClipRect: T2DIntRect);
var
  UseOrgClipRgn: boolean;
  ClipRgn: HRGN;
  OrgRgn: HRGN;
begin
  // Store the original ClipRgn and set a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);

  DrawAARoundFrame(ACanvas, Rect, Radius, Color);

  // Restores previous ClipRgn and removes used regions
  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawDisabledImage(ABitmap: TBitmap;
  Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector;
  ClipRect: T2DIntRect);
begin
  DrawDisabledImage(ABitmap.Canvas, ImageList, ImageIndex, Point, ClipRect);
end;

class procedure TGUITools.DrawDisabledImage(ABitmap: TBitmap;
  Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector);
begin
  DrawDisabledImage(ABitmap.Canvas, ImageList, ImageIndex, Point);
end;

class procedure TGUITools.DrawDisabledImage(ACanvas: TCanvas;
  Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector;
  ClipRect: T2DIntRect);
var
  UseOrgClipRgn: Boolean;
  OrgRgn: HRGN;
  ClipRgn: HRGN;
  DCStackPos : integer;
begin
  // Store the original ClipRgn and set a new one
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);

  SelectClipRgn(ACanvas.Handle, ClipRgn);

  // Hack fixes the bug in ImageList.Draw which does not restore the previous one  /???
  // Font color for canvas
  DcStackPos := SaveDC(ACanvas.Handle);
  ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex, false);
  RestoreDC(ACanvas.Handle, DcStackPos);

  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);

  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawDisabledImage(ACanvas: TCanvas;
  Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector);
var
  DCStackPos : integer;
begin
  //todo: see if is necessary to save the DC
  DcStackPos := SaveDC(ACanvas.Handle);
  ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex, false);
  RestoreDC(ACanvas.Handle, DcStackPos);
end;

class procedure TGUITools.DrawCheckbox(ACanvas:TCanvas; x,y: Integer;
  AState: TCheckboxState; AButtonState:TSpkButtonState;
  AStyle: TSpkCheckboxStyle; ClipRect:T2DIntRect);
var
  UseOrgClipRgn: Boolean;
  OrgRgn: HRGN;
  ClipRgn: HRGN;
begin
  SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
  if UseOrgClipRgn then
    CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);
  SelectClipRgn(ACanvas.Handle, ClipRgn);
  DrawCheckbox(ACanvas, x,y, AState, AButtonState, AStyle);
  RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
  DeleteObject(ClipRgn);
end;

class procedure TGUITools.DrawCheckbox(ACanvas: TCanvas; x,y: Integer;
  AState: TCheckboxState; AButtonState: TSpkButtonState;
  AStyle: TSpkCheckboxStyle);
const
  NOT_USED = tbCheckboxCheckedNormal;
const
  UNTHEMED_FLAGS: array [TSpkCheckboxStyle, TCheckboxState] of Integer = (
    (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED, DFCS_BUTTONCHECK or DFCS_BUTTON3STATE),
    (DFCS_BUTTONRADIO, DFCS_BUTTONRADIO or DFCS_CHECKED, DFCS_BUTTONRADIO or DFCS_BUTTON3STATE)
  );
  THEMED_FLAGS: array [TSpkCheckboxStyle, TCheckboxState, TSpkButtonState] of TThemedButton = (
    ( (tbCheckboxUncheckedNormal, tbCheckboxUncheckedHot, tbCheckboxUncheckedPressed, tbCheckboxUncheckedDisabled, NOT_USED),
      (tbCheckboxCheckedNormal, tbCheckboxCheckedHot, tbCheckboxCheckedPressed, tbCheckboxCheckedDisabled, NOT_USED),
      (tbCheckboxMixedNormal, tbCheckboxMixedHot, tbCheckboxMixedPressed, tbCheckboxMixedDisabled, NOT_USED)
    ),
    ( (tbRadioButtonUncheckedNormal, tbRadioButtonUncheckedHot, tbRadioButtonUncheckedPressed, tbRadioButtonUncheckedDisabled, NOT_USED),
      (tbRadioButtonCheckedNormal, tbRadioButtonCheckedHot, tbRadioButtonCheckedPressed, tbRadioButtonCheckedDisabled, NOT_USED),
      (tbRadioButtonCheckedNormal, tbRadioButtonCheckedHot, tbRadioButtonCheckedPressed, tbRadioButtonCheckedDisabled, NOT_USED)
    )
  );
var
  R: TRect;
  w: Integer;
  sz: TSize;
  te: TThemedElementDetails;
begin
  if ThemeServices.ThemesEnabled then begin
    te := ThemeServices.GetElementDetails(THEMED_FLAGS[AStyle, AState, AButtonState]);
    sz := ThemeServices.GetDetailSize(te);
    R := Bounds(x, y, sz.cx, sz.cy);
    InflateRect(R, 1, 1);
    ThemeServices.DrawElement(ACanvas.Handle, te, R);
  end else begin
    w := GetSystemMetrics(SM_CYMENUCHECK);
    R := Bounds(x, y, w, w);
    DrawFrameControl(
      ACanvas.Handle, R, DFC_BUTTON, UNTHEMED_FLAGS[AStyle, AState]);
  end;
end;

end.