{ ------------------------------------------------------------- }
{ Purpose : Next Standard 6                                     }
{ By      : Bojan Nikolic                                       }
{ For     : BergSoft                                            }
{ ------------------------------------------------------------- }
{ Copyright (C) BergSoft.net 2021. All Rights Reserved.         }
{ ------------------------------------------------------------- }
{$I NxSuite6.inc}

unit NxGraphics6;

interface

uses
  Classes, Types, Windows, Graphics, SysUtils, Math, Controls, Messages, ImgList,
  {$IFDEF UI_TYPES}UITypes,{$ENDIF}
  { Next Standard 6}
  NxIntf6, NxClasses6, NxTypes6, NxConsts6;

type
  TQuadColor = packed record
    case Boolean of
      True: (Blue, Green, Red, Alpha: Byte);
      False: (Quad: Cardinal);
    end;

  PQuadColor = ^TQuadColor;
  PPQuadColor = ^PQuadColor;

  TNxCanvasSnapshot = record
    Brush: record
      Color: TColor;
    end;
    Font: record
      Color: TColor;
      Name: string;
      Size: Integer;
      Style: TFontStyles;
    end;
  end;

{$IFDEF THEMED_RENAME}
  function Themed: Boolean;
{$ENDIF}

{ Snapshots }
function GetCanvasSnapshot(Canvas: TCanvas): TNxCanvasSnapshot;
procedure PutCanvasSnapshot(Canvas: TCanvas; Snapshoot: TNxCanvasSnapshot);

{ Modern Gui }
procedure DrawModernButton(Canvas: TCanvas; ButtonRect: TRect; State: TNxButtonState); overload;
procedure DrawModernButton(Canvas: TCanvas; Text: WideString; ButtonRect: TRect;
  State: TNxButtonState); overload;
procedure DrawModernButton(Canvas: TCanvas; Text, ResName: WideString; ButtonRect: TRect;
  State: TNxButtonState); overload;
procedure DrawModernToolButton(Canvas: TCanvas; ButtonRect: TRect; State: TNxButtonState); overload;

procedure PaintToolButton(Canvas: TCanvas; Text: WideString;
  ButtonRect: TRect; State: TNxButtonState);

{ Blending }
procedure AlphaBlend(Canvas: TCanvas; Bitmap: TBitmap; const X, Y: Integer);

{ Drawing Glyphs }
procedure DrawBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap);
procedure DrawBitmapFromRes(Canvas: TCanvas; Location: TPoint; Resource: string; Transparent: Boolean = False); overload;
procedure DrawBitmapFromRes(Canvas: TCanvas; Rect: TRect; Alignment: TAlignment; VerticalAlignment: TVerticalAlignment; Resource: string; Transparent: Boolean = False); overload;
procedure DrawGraphic(Canvas: TCanvas; X, Y: Integer; Graphic: TGraphic); overload;
procedure DrawGraphic(Canvas: TCanvas; X, Y: Integer; Graphic: TGraphic; Enabled: Boolean); overload;
function HasGraphic(const APicture: TPicture): Boolean;

{ Drawing }
procedure DrawFocusRect(Canvas: TCanvas; Rect: TRect);
procedure DrawGrayscaleBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap);
procedure Draw32BitBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap);
procedure DrawDotLine(Canvas: TCanvas; const X1, Y1, X2, Y2: Integer; Color: TColor);
procedure DrawFrameRect(Canvas: TCanvas; FrameRect: TRect; Width: Integer);
procedure DrawGrid(Canvas: TCanvas; GridRect: TRect; Step: Integer);
procedure DrawImage(Canvas: TCanvas; Dest: TRect; Images: TImageList; Alignment: TAlignment; VerticalAlignment: TVerticalAlignment; Index: TImageIndex);
procedure DrawSizeGrip(Canvas: TCanvas; GripRect: TRect; Color: TColor);
procedure DrawTextRect(Canvas: TCanvas; TextRect: TRect; Alignment: TAlignment;
  VertAlignment: TVerticalAlignment; Text: WideString; WrapKind: TNxWrapKind; AcceleratedChars: Boolean = False);
procedure DrawTextOut(Canvas: TCanvas; X, Y: Integer; Text: WideString);
procedure DrawEllipsis(Canvas: TCanvas; Rect: TRect; BrushColor: TColor);
procedure DrawPlus(Canvas: TCanvas; PlusRect: TRect; BrushColor: TColor);
procedure DrawVertTextRect(Canvas: TCanvas; TextRect: TRect; Alignment: TAlignment;
  VertAlignment: TVerticalAlignment; Text: WideString; WrapKind: TNxWrapKind);

{ PaintEffects }
procedure PaintEffects(Canvas: TCanvas; Dest: TRect; Effects: TNxPaintEffects);
procedure ColorOverlay(Canvas: TCanvas; Source: TRect; Color: TColor; const Alpha: Byte);

{ Bevel }
procedure DrawBevel(Canvas: TCanvas; Dest: TRect; GrayLevel: Byte; Intensity: Double;
  Orientation: TNxOrientation; Inverted: Boolean);
procedure DrawBevels(Canvas: TCanvas; Dest: TRect; BevelSize: Integer);

{ Inner Shadow }
procedure DrawInnerShadows(Canvas: TCanvas; ARect: TRect; ShadowSize: Integer);
procedure DrawInnerShadow(Canvas: TCanvas; Dest: TRect; GrayLevel: Byte; Intensity: Double;
  Orientation: TNxOrientation); overload;

{ Light }
procedure DrawLight(Canvas: TCanvas; InnerRct: TRect; Size: Integer); overload;
procedure DrawReflection(Canvas: TCanvas; InnerRct: TRect; Size: Integer);

{ Shadow }
procedure DrawShadow(Canvas: TCanvas; Inner: TRect; Orientation: TNxOrientation); overload;
procedure DrawShadows(Canvas: TCanvas; InnerRct: TRect; Size: Integer); overload;

{ Drawing Elements }
procedure DrawDetailsMark(Canvas: TCanvas; const X, Y: Integer; Color: TColor);
procedure DrawDropDownMark(Canvas: TCanvas; const X, Y: Integer; Color: TColor);
procedure DrawIndicatorArrow(Canvas: TCanvas; Rect: TRect; Color: TColor);
procedure DrawSortArrow(Canvas: TCanvas; const X, Y: Integer; SortKind: TNxSortKind);

{ Fading }
procedure FadeHorz(Canvas: TCanvas; SourceRect: TRect; InvertDirection: Boolean = False);
procedure FadeVert(Canvas: TCanvas; SourceRect: TRect);

{ Manipulation }
procedure FlipVert(Source: TBitmap);

{ Measuring }
procedure ConstrainedRect(Graphic: TGraphic; var Src: TRect);
function GetTextHeight(Canvas: TCanvas; Text: WideString; WordWrap: Boolean): Integer; overload;
function GetTextHeight(Canvas: TCanvas; Width: Integer; Text: WideString): Integer; overload;
function GetTextHeight(Canvas: TCanvas; Width: Integer; Text: WideString; WrapKind: TNxWrapKind): Integer; overload;
function GetTextWidth(Canvas: TCanvas; Text: WideString; WrapKind: TNxWrapKind): Integer; overload;
function GetTextWidth(Canvas: TCanvas; Text: WideString; FixedWidth: Integer): Integer; overload;
function GetTextMetric(Canvas: TCanvas): TTextMetric;
function GetTextSize(Handle: HDC; TextRect: TRect; Text: WideString): TSize; overload;
function GetTextSize(Handle: HDC; TextRect: TRect; Text: WideString; WrapKind: TNxWrapKind): TSize; overload;
function GetTextSize(Canvas: TCanvas; Text: WideString; NoPrefix: Boolean): TSize; overload;

{ Utilities }

function ColorToWebColor(Color: TColor): string;
function ColorNameToColor(S: string): TColor;

function BlendColor(Color1, Color2: TColor; Amount: Byte): TColor;
function DelphiColorToColor(DelphiColor: string): TColor;
procedure EraseBackground(Control: TCustomControl; Canvas: TCanvas);
function WebColorToColor(WebColor: string): TColor;
function WebColorName(Value: string): string;
function WebColorValue(Color: string): string;
procedure GetRGB(C: TColor; out R, G, B: Byte);
function GetSystemColor(Color: TColor): TColor;
function HTMLColorToString(Color: TColor): string;
function DarkerColor(Color: TColor; Percent: Byte): TColor;
function LighterColor(Color: TColor; Percent: Byte): TColor;
function ColorBrightness(const Color: TColor ): byte;
function RandomColor: TColor;
function RectInRect(Container, Target: TRect): Boolean;
function RectIntersect(Rect1, Rect2: TRect): Boolean;
procedure SetFontQuality(Font: TFont; Quality: Byte);
function StrToColor(S: string): TColor;
function PosInRect(Width, Height: Integer; Container: TRect;
  Alignment: TAlignment; VerticalAlignment: TVerticalAlignment): TPoint;
function IsColorLight(Color: TColor): Boolean;

{ Clipping  }
procedure SetClipRect(Canvas: TCanvas; ClipRect: TRect);
procedure ExcludeClipRect(Canvas: TCanvas; ClipRect: TRect);

{ Misc. }

procedure FillPadding(Canvas: TCanvas; Color: TColor; Dest: TRect; Padding: TPadding);

{ TRect }

function AnchorRect(Container: TRect; Size: TSize; Anchors: TAnchors;
  Offset: TPoint): TRect;

{ TGraphic }

function FitToRect(Source, Destination: TRect): TRect;
function PaintGraphic(Canvas: TCanvas; Graphic: TGraphic; Dest: TRect;
  FillMode: TNxFillMode): TRect;

{ Dpi Scalling }
function DotToPixel(Value: TRect): TRect; overload;
function DotToPixel(Value: TSize): TSize; overload;
function DotToPixel(Value: Integer): Integer; overload;

//function Scaled(Value: Integer): Integer;

function DeviceIndipendedPoint(Value: Integer): Integer; overload;
function DeviceIndipendedPoint(Value: TPadding): TPadding; overload;

procedure OffsetRectPt(var lprc: TRect; dx, dy: Integer);

function DpiScalePadding(Value: TPadding): TIndentation;
function ScalePadding(Value: TPadding): TInsets;

procedure InflateRectScaled(var lprc: TRect; Padding: TPadding);
procedure ScalePoints(Start: Integer; Points: array of TPoint);

implementation

uses
  { Standard }
  Dialogs, StrUtils, Forms,
{$IFDEF THEMES}
  UxTheme
{$ELSE}
  NxTheme6
{$ENDIF}
;

{$IFDEF THEMED_RENAME}
function Themed: Boolean;
begin
  Result := IsThemeActive;
end;
{$ENDIF}

function AnchorRect(Container: TRect; Size: TSize; Anchors: TAnchors;
  Offset: TPoint): TRect;
var
  StartPoint, EndPoint: TPoint;
begin
  StartPoint := Point(0, 0);
  EndPoint := Point(0, 0);
  if akLeft in Anchors then
  begin
    StartPoint.X := Container.Left + Offset.X;
    EndPoint.X := Min(StartPoint.X + Size.cx, Container.Right);
  end;
  if akTop in Anchors then
  begin
    StartPoint.Y := Container.Top + Offset.Y;
    EndPoint.Y := Min(StartPoint.Y + Size.cy, Container.Bottom);
  end;
  if akRight in Anchors then
  begin
    EndPoint.X := Container.Right - Offset.X;
    if not (akLeft in Anchors) then StartPoint.X := Max(EndPoint.X - Size.cx, Container.Left);
  end;
  if akBottom in Anchors then
  begin
    EndPoint.Y := Container.Bottom - Offset.Y;
    if not (akTop in Anchors) then StartPoint.Y := Max(EndPoint.Y - Size.cy, Container.Top);
  end;
  Result := Rect(StartPoint.X, StartPoint.Y, EndPoint.X, EndPoint.Y);
end;

function GetCanvasSnapshot(Canvas: TCanvas): TNxCanvasSnapshot;
begin
  Result.Brush.Color := Canvas.Brush.Color;
  Result.Font.Color := Canvas.Font.Color;
  Result.Font.Name := Canvas.Font.Name;
  Result.Font.Size := Canvas.Font.Size;
  Result.Font.Style := Canvas.Font.Style;
end;

procedure PutCanvasSnapshot(Canvas: TCanvas; Snapshoot: TNxCanvasSnapshot);
begin
  Canvas.Brush.Color := Snapshoot.Brush.Color;
  Canvas.Font.Color := Snapshoot.Font.Color;
  Canvas.Font.Size := Snapshoot.Font.Size;
  Canvas.Font.Style := Snapshoot.Font.Style;
  Canvas.Font.Name := Snapshoot.Font.Name;
end;

procedure PaintToolButton(Canvas: TCanvas; Text: WideString;
  ButtonRect: TRect; State: TNxButtonState);
var
  FaceColor: TColor;
begin
  with Canvas do
  begin
    { Default style }
    FaceColor := clWindow;

    if bsSelected in State
      then FaceColor := ColorOf(seBtnFaceChecked);

    if bsHover in State then
    begin
      FaceColor := ColorOf(seBtnFace);

      if bsPressed in State
        then FaceColor := ColorOf(seBtnFacePressed);
    end;

    Brush.Color := FaceColor;
    FillRect(ButtonRect);
  end;

  DrawTextRect(Canvas, ButtonRect, Classes.taCenter, taVerticalCenter, Text, wkEllipsis);
end;

procedure DrawModernButton(Canvas: TCanvas; ButtonRect: TRect; State: TNxButtonState);
var
  FrameColor, FaceColor: TColor;
begin
  with Canvas do
  begin
    { Default style }
    FrameColor := ColorOf(seBtnFrame);
    FaceColor := clWindow;

    if bsHover in State then
    begin
      FrameColor := ColorOf(seBtnFacePressed);
      FaceColor := ColorOf(seBtnFace);

      if bsPressed in State then
      begin
        FrameColor := ColorOf(seBtnFramePressed);
        FaceColor := ColorOf(seBtnFacePressed);
      end;

    end;

    if (bsSelected in State) or (bsChecked in State) then
    begin
      FrameColor := ColorOf(seBtnFramePressed);
      FaceColor := ColorOf(seBtnFaceChecked);
    end;

    Canvas.Pen.Color := FrameColor;
    Canvas.Brush.Color := FaceColor;
    Canvas.Rectangle(ButtonRect);

  end;
end;

procedure DrawModernButton(Canvas: TCanvas; Text: WideString; ButtonRect: TRect;
  State: TNxButtonState);
begin
  DrawModernButton(Canvas, ButtonRect, State);

  DrawTextRect(Canvas, ButtonRect, Classes.taCenter, taVerticalCenter, Text, wkEllipsis);
end;

procedure DrawModernButton(Canvas: TCanvas; Text, ResName: WideString; ButtonRect: TRect;
  State: TNxButtonState);
var
  TextRect, IconRect: TRect;
begin
  DrawModernButton(Canvas, ButtonRect, State);

  IconRect := ButtonRect;
  Inc(IconRect.Left, spGrid);

  DrawBitmapFromRes(Canvas, IconRect, taLeftJustify, taVerticalCenter, ResName, True);

  TextRect := ButtonRect;
  Inc(TextRect.Left, spGrid + 16 + pdDouble);

  DrawTextRect(Canvas, TextRect, taLeftJustify, taVerticalCenter, Text, wkEllipsis);
end;

procedure DrawModernToolButton(Canvas: TCanvas; ButtonRect: TRect; State: TNxButtonState);
var
  FaceColor: TColor;
begin
  with Canvas do
  begin
    FaceColor := clNone;

    if (bsChecked in State) or (bsPressed in State) then
    begin
      FaceColor := ColorOf(seBtnFaceChecked);
    end;

    if bsHover in State then
    begin
      FaceColor := ColorOf(seBtnFace);
      if bsPressed in State then FaceColor := ColorOf(seBtnFacePressed);
    end;

    if FaceColor <> clNone then
    begin
      Brush.Color := FaceColor;
      FillRect(ButtonRect);
    end;
  end;
end;

procedure AlphaBlend(Canvas: TCanvas; Bitmap: TBitmap; const X, Y: Integer);
var
  Func: TBlendFunction;
begin
  { Blending Params }
  Func.BlendOp := AC_SRC_OVER;
  Func.BlendFlags := 0;
  Func.SourceConstantAlpha := 255;
  Func.AlphaFormat := AC_SRC_ALPHA;

  { Do Blending }
  Windows.AlphaBlend(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle,
    0, 0, Bitmap.Width, Bitmap.Height, Func);
end;

procedure ColorOverlay(Canvas: TCanvas; Source: TRect; Color: TColor; const Alpha: Byte);
var
  Row, Col: Integer;
  Pixel: PQuadColor;
  Mask: TBitmap;
begin
  if Alpha = 255 then
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect(Source);

    { Skip complex computings }
    Exit;
  end;

  { Convert SystemColor }
  if Integer(Color) < 0 then Color := GetSysColor(Color and $000000FF);

  { 10/26/11: We create an Alpha Mask TBitmap here which
              will be aplied into Canvas }
  Mask := TBitmap.Create;

  with Mask do
  begin
    { Important for AlphaBlend Func }
    PixelFormat := pf32bit;
    { Set Size of Mask }
    Width := Source.Right - Source.Left;
    Height := Source.Bottom - Source.Top;
  end;

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    for Col := 0 to Pred(Mask.Width) do
    begin
      Pixel.Red := GetRValue(Color);
      Pixel.Green := GetGValue(Color);
      Pixel.Blue := GetBValue(Color);

      { Set Alpha }
      Pixel.Alpha := Alpha;

      { Premultiply R, G & B }
      Pixel.Red := MulDiv(Pixel.Red, Pixel.Alpha, $FF);
      Pixel.Green := MulDiv(Pixel.Green, Pixel.Alpha, $FF);
      Pixel.Blue := MulDiv(Pixel.Blue, Pixel.Alpha, $FF);

      { Move to next Pixed }
      Inc(Pixel);

    end; { for Col }

  end; { for Row }

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, Source.Left, Source.Top);

  { Release }
  Mask.Free;
end;

procedure DrawBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap);
begin
  case Bitmap.PixelFormat of
    pfDevice, pf1bit, pf4bit, pf8bit,
    pf15bit, pf16bit, pf24bit: Canvas.Draw(X, Y, Bitmap);
    pf32bit: Draw32BitBitmap(Canvas, X, Y, Bitmap);
    pfCustom: ;
  end;
end;

procedure DrawBitmapFromRes(Canvas: TCanvas; Location: TPoint; Resource: string;
  Transparent: Boolean = False);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    { Load }
    Bitmap.LoadFromResourceName(HInstance, Resource);

    Canvas.Draw(Location.X, Location.Y, Bitmap);
  finally
    Bitmap.Free;
  end;
end;

procedure DrawBitmapFromRes(Canvas: TCanvas; Rect: TRect; Alignment: TAlignment;
  VerticalAlignment: TVerticalAlignment; Resource: string;
  Transparent: Boolean = False);
var
  Bitmap: TBitmap;
  Location: TPoint;
begin
  Bitmap := TBitmap.Create;
  try

    { Load }
    Bitmap.LoadFromResourceName(HInstance, Resource);

    Location := PosInRect(Bitmap.Width, Bitmap.Height, Rect, Alignment, VerticalAlignment);

    if Transparent then
    begin
      Bitmap.Transparent := True;
      Bitmap.TransparentColor := Bitmap.Canvas.Pixels[0, Pred(Bitmap.Height)];
    end;

    Canvas.Draw(Location.X, Location.Y, Bitmap);
  finally
    Bitmap.Free;
  end;
end;

procedure DrawGraphic(Canvas: TCanvas; X, Y: Integer; Graphic: TGraphic);
begin
  if Graphic is TBitmap then DrawBitmap(Canvas, X, Y, Graphic as TBitmap)
    else Canvas.Draw(X, Y, Graphic);
end;

procedure DrawGraphic(Canvas: TCanvas; X, Y: Integer; Graphic: TGraphic; Enabled: Boolean);
begin
  if Graphic is TBitmap then
  begin
    if Enabled then
      DrawBitmap(Canvas, X, Y, Graphic as TBitmap)
    else
      DrawGrayscaleBitmap(Canvas, X, Y, Graphic as TBitmap);
  end
  else Canvas.Draw(X, Y, Graphic);
end;

function HasGraphic(const APicture: TPicture): Boolean;
begin
  Result := Assigned(APicture) and Assigned(APicture.Graphic)
    and not APicture.Graphic.Empty;
end;

procedure DrawFocusRect(Canvas: TCanvas; Rect: TRect);
var
  PrevBkColor, PrevTextColor: TColorRef;
  DC: HDC;
begin
  DC := Canvas.Handle;
  PrevBkColor := SetBkColor(DC, clBlack);
  PrevTextColor := SetTextColor(DC, clWhite);
  Windows.DrawFocusRect(DC, Rect);
  SetBkColor(DC, PrevBkColor);
  SetTextColor(DC, PrevTextColor);
end;

procedure DrawGrayscaleBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap);
var
  Row, Col, Grey: Integer;
  Pixel: PQuadColor;
  Mask: TBitmap;

begin
  { 10/26/11: We create an Alpha Mask TBitmap here which
              will be aplied into Canvas }
  Mask := TBitmap.Create;

  with Mask do
  begin
    { Important for AlphaBlend Func }
    PixelFormat := pf32bit;

    { Set Size of Mask }
    Width := Bitmap.Width;
    Height := Bitmap.Height;

    Canvas.CopyRect(Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap.Canvas, Bounds(0, 0, Bitmap.Width, Bitmap.Height));
  end;

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    for Col := 0 to Pred(Mask.Width) do
    begin
      Grey := Round (0.30 * Pixel.Red + 0.59 * Pixel.Green + 0.11 * Pixel.Blue);

      Pixel.Red := Grey;
      Pixel.Green := Grey;
      Pixel.Blue := Grey;

      Pixel.Alpha := 255;

      { Premultiply R, G & B }
      Pixel.Red := MulDiv(Pixel.Red, Pixel.Alpha, $FF);
      Pixel.Green := MulDiv(Pixel.Green, Pixel.Alpha, $FF);
      Pixel.Blue := MulDiv(Pixel.Blue, Pixel.Alpha, $FF);

      { Move to next Pixel }
      Inc(Pixel);

    end; { for Col }

  end; { for Row }

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, X, Y);

  { Release }
  Mask.Free;
end;

procedure Draw32BitBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap);
var
  Row, Col: Integer;
  Pixel: PQuadColor;
  Mask: TBitmap;

begin
  { 10/26/11: We create an Alpha Mask TBitmap here which
              will be aplied into Canvas }
  Mask := TBitmap.Create;

  with Mask do
  begin
    { Important for AlphaBlend Func }
    PixelFormat := pf32bit;

    { Set Size of Mask }
    Width := Bitmap.Width;
    Height := Bitmap.Height;

    Canvas.CopyRect(Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap.Canvas, Bounds(0, 0, Bitmap.Width, Bitmap.Height));
  end;

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    for Col := 0 to Pred(Mask.Width) do
    begin

      { Premultiply R, G & B }
      Pixel.Red := MulDiv(Pixel.Red, Pixel.Alpha, $FF);
      Pixel.Green := MulDiv(Pixel.Green, Pixel.Alpha, $FF);
      Pixel.Blue := MulDiv(Pixel.Blue, Pixel.Alpha, $FF);

      { Move to next Pixel }
      Inc(Pixel);

    end; { for Col }

  end; { for Row }

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, X, Y);

  { Release }
  Mask.Free;
end;

procedure DrawDotLine(Canvas: TCanvas; const X1, Y1, X2, Y2: Integer; Color: TColor);
var
  LogBrush: TLogBrush;
begin
  with Canvas do
  begin
    Pen.Color := GetSystemColor(Color);
    LogBrush.lbStyle := BS_SOLID;
    LogBrush.lbColor := Pen.Color;
{$IFDEF USER_STYLE_PEN}
    Pen.Style := psUserStyle;
{$ENDIF}
    Pen.Handle := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE, Pen.Width,
      LogBrush, Length(DotDotPenStyle), @DotDotPenStyle);
    MoveTo(X1, Y1);
    LineTo(X2, Y2);
    Pen.Style := psSolid;
  end;
end;

procedure DrawFrameRect(Canvas: TCanvas; FrameRect: TRect; Width: Integer);
var
  i: Integer;
  Rect: TRect;
begin
  Rect := FrameRect;
  for i := 1 to Width do
  begin
    Canvas.FrameRect(Rect);
    InflateRect(Rect, -1, -1);
  end;
end;

procedure DrawGrid(Canvas: TCanvas; GridRect: TRect; Step: Integer);
var
  i, j: Integer;
begin
  j := GridRect.Top;
  i := GridRect.Left;
  while j < GridRect.Bottom do
  begin
    while i < GridRect.Right do
    begin
      Canvas.Pixels[i, j] := clGrayText;
      Inc(i, Step);
    end;
    Inc(j, Step);
    i := GridRect.Left;
  end;
end;

procedure DrawImage(Canvas: TCanvas; Dest: TRect; Images: TImageList; Alignment: TAlignment; VerticalAlignment: TVerticalAlignment; Index: TImageIndex);
var
  Location: TPoint;
begin
  Location := PosInRect(Images.Width, Images.Height, Dest, Alignment, VerticalAlignment);
  Images.Draw(Canvas, Location.X, Location.Y, Index);
end;

procedure DrawBevels(Canvas: TCanvas; Dest: TRect; BevelSize: Integer); overload;
begin
  { Dark }
  DrawBevel(Canvas, Rect(Dest.Left, Dest.Bottom - BevelSize, Dest.Right, Dest.Bottom), 0, 0.5, orHorizontal, False);
  DrawBevel(Canvas, Rect(Dest.Right - BevelSize, Dest.Top, Dest.Right, Dest.Bottom), 0, 0.5, orVertical, False);

  { Light }
  DrawBevel(Canvas, Rect(Dest.Left, Dest.Top, Dest.Right, Dest.Top + BevelSize), 255, 0.5, orHorizontal, True);
  DrawBevel(Canvas, Rect(Dest.Left, Dest.Top, Dest.Left + BevelSize, Dest.Bottom), 255, 0.5, orVertical, True);
end;

procedure DrawBevel(Canvas: TCanvas; Dest: TRect; GrayLevel: Byte; Intensity: Double;
  Orientation: TNxOrientation; Inverted: Boolean); overload;
var
  Row, Col: Integer;
  Alpha: Single;
  Pixel: PQuadColor;
  AlphaByte: Byte;
  Mask: TBitmap;
begin
  { 10/26/11: We create an Alpha Mask TBitmap here which
              will be aplied into Canvas }
  Mask := TBitmap.Create;

  with Mask do
  begin
    { Important for AlphaBlend Func }
    PixelFormat := pf32bit;
    { Set Size of Mask }
    Width := Dest.Right - Dest.Left;
    Height := Dest.Bottom - Dest.Top;
  end;

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    for Col := 0 to Pred(Mask.Width) do
    begin
      { Calculate Alpha }
      case Orientation of
        orHorizontal:
          if Inverted then
          begin
            Alpha := 1 - ((Succ(Row) / Mask.Height) * (1 - Intensity));
          end else
          begin
            Alpha := (Succ(Row) / Mask.Height) * Intensity;
          end;
        else
          if Inverted then
          begin
            Alpha := 1 - ((Succ(Col) / Mask.Width) * (1 - Intensity));
          end else
          begin
            Alpha := (Succ(Col) / Mask.Width) * Intensity;
          end;
      end;

      { Convert 0-1 to 0-255 }
      AlphaByte := Round(Alpha * 255.0);

      Pixel.Red := GrayLevel;
      Pixel.Green := GrayLevel;
      Pixel.Blue := GrayLevel;

      { Set Alpha }
      Pixel.Alpha := AlphaByte;

      { Premultiply R, G & B }
      Pixel.Red := Round(Pixel.Red * Alpha);
      Pixel.Green := Round(Pixel.Green * Alpha);
      Pixel.Blue := Round(Pixel.Blue * Alpha);

      { Move to next Pixed }
      Inc(Pixel);
    end; { for Col }

  end; { for Row }

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, Dest.Left, Dest.Top);

  { Release }
  Mask.Free;
end;

procedure DrawInnerShadow(Canvas: TCanvas; Dest: TRect; GrayLevel: Byte; Intensity: Double;
  Orientation: TNxOrientation); overload;
var
  Row, Col: Integer;
  Alpha: Single;
  Pixel: PQuadColor;
  PixelByte: Byte;
  Mask: TBitmap;
begin
  Mask := TBitmap.Create;

  with Mask do
  begin
    { Required by AlphaBlend WinApi Func }
    PixelFormat := pf32bit;

    { Set Size of Mask }
    Width := Dest.Right - Dest.Left;
    Height := Dest.Bottom - Dest.Top;
  end;

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    for Col := 0 to Pred(Mask.Width) do
    begin

      { Calculate Alpha }
      case Orientation of
        orHorizontal: Alpha := 1 - ((Succ(Row) / Mask.Height));
        else Alpha := 1 - ((Succ(Col) / Mask.Width));
      end;

      Alpha := Alpha * Intensity;

      { Pixel Color is level of gray }
      PixelByte := Round(GrayLevel * Alpha);
      Pixel.Red := PixelByte;
      Pixel.Green := PixelByte;
      Pixel.Blue := PixelByte;

      { Convert 0-1 to 0-255 & set Alpha }
      Pixel.Alpha := Round(Alpha * 255.0);

      { Move to next Pixed }
      Inc(Pixel);

    end; { for Col }

  end; { for Row }

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, Dest.Left, Dest.Top);

  { Release }
  Mask.Free;
end;

procedure DrawInnerShadows(Canvas: TCanvas; ARect: TRect; ShadowSize: Integer);
begin
  DrawInnerShadow(Canvas, Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Top + ShadowSize),
    0, 0.5, orHorizontal);
  DrawInnerShadow(Canvas, Rect(ARect.Left, ARect.Top, ARect.Left + ShadowSize, ARect.Bottom),
    0, 0.5, orVertical);
end;

procedure DrawLight(Canvas: TCanvas; InnerRct: TRect; Size: Integer); overload;
var
  Row, Col, Middle: Integer;
  Alpha: Single;
  Pixel: PQuadColor;
  AlphaByte: Byte;
  Mask: TBitmap;
begin
  { 10/26/11: We create an Alpha Mask TBitmap here which
              will be aplied into Canvas }
  Mask := TBitmap.Create;

  Middle := ((InnerRct.Right - InnerRct.Left) div 3) * 2;

  if Middle = 0 then Exit;

  with Mask do
  begin
    { Important for AlphaBlend Func }
    PixelFormat := pf32bit;

    { Set Size of Mask }
    Width := InnerRct.Right - InnerRct.Left;
    Height := InnerRct.Bottom - InnerRct.Top;
  end;

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    for Col := 0 to Pred(Mask.Width) do
    begin
      Pixel.Red := 255;
      Pixel.Green := 255;
      Pixel.Blue := 255;

      { Determine Alpha Level }
      Alpha := (Middle - Row) / Middle;

      { Convert 0-1 to 0-255 }
      AlphaByte := Round(Alpha * 255.0);

      if Col + Row > Middle then AlphaByte := 0;

      { Set Alpha }
      Pixel.Alpha := AlphaByte;

      { Premultiply R, G & B }
      Pixel.Red := Round(Pixel.Red * Alpha);
      Pixel.Green := Round(Pixel.Green * Alpha);
      Pixel.Blue := Round(Pixel.Blue * Alpha);

      { Move to next Pixed }
      Inc(Pixel);

    end; { for Col }

  end; { for Row }

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, InnerRct.Left, InnerRct.Top);

  { Release }
  Mask.Free;
end;

procedure DrawReflection(Canvas: TCanvas; InnerRct: TRect; Size: Integer);
var
  Row, Col: Integer;
  Alpha: Single;
  Pixel: PQuadColor;
  AlphaByte: Byte;
  Mask: TBitmap;
begin
  { 10/26/11: We create an Alpha Mask TBitmap here which
              will be aplied into Canvas }
  Mask := TBitmap.Create;

  with Mask do
  begin
    { Important for AlphaBlend Func }
    PixelFormat := pf32bit;
    { Set Size of Mask }
    Width := InnerRct.Right - InnerRct.Left;
    Height := InnerRct.Bottom - InnerRct.Top;
  end;

  { Copy TRect from Canvas into Bitmap }
  Mask.Canvas.CopyRect(Rect(0, 0, Mask.Width, Mask.Height), Canvas, InnerRct);

  { Flip Bitmap }
  FlipVert(Mask);

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    for Col := 0 to Pred(Mask.Width) do
    begin
      if Row < Size
        then Alpha := (Size - Row) / Size
        else Alpha := 0;

      { Convert 0-1 to 0-255 }
      AlphaByte := Round(Alpha * 255.0);

      { Set Alpha }
      Pixel.Alpha := AlphaByte;

      { Premultiply R, G & B }
      Pixel.Red := Round(Pixel.Red * Alpha);
      Pixel.Green := Round(Pixel.Green * Alpha);
      Pixel.Blue := Round(Pixel.Blue * Alpha);

      { Move to next Pixed }
      Inc(Pixel);

    end; { for Col }

  end; { for Row }

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, InnerRct.Left, InnerRct.Bottom + 1);

  { Release }
  Mask.Free;
end;

procedure DrawShadows(Canvas: TCanvas; InnerRct: TRect; Size: Integer);
begin
  { Draw Horz Shadow }
  DrawShadow(Canvas, Rect(InnerRct.Left, InnerRct.Bottom, InnerRct.Right + Size, InnerRct.Bottom + Size), orHorizontal);

  { Draw Vert Shadow }
  DrawShadow(Canvas, Rect(InnerRct.Right, InnerRct.Top, InnerRct.Right + Size, InnerRct.Bottom + Size - 1), orVertical);
end;

procedure DrawShadow(Canvas: TCanvas; Inner: TRect; Orientation: TNxOrientation);
var
  Row, Col: Integer;
  Alpha: Single;
  Pixel: PQuadColor;
  AlphaByte: Byte;
  Mask: TBitmap;
begin
  { 10/26/11: We create an Alpha Mask TBitmap here which
              will be aplied into Canvas }
  Mask := TBitmap.Create;

  with Mask do
  begin
    { Important for AlphaBlend Func }
    PixelFormat := pf32bit;
    { Set Size of Mask }
    Width := Inner.Right - Inner.Left;
    Height := Inner.Bottom - Inner.Top;
  end;

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    for Col := 0 to Pred(Mask.Width) do
    begin
      Pixel.Red := 0;
      Pixel.Green := 0;
      Pixel.Blue := 0;

      { Determine Alpha Level }
      case Orientation of
        orHorizontal:
          begin
            Alpha := (Mask.Height - Row) / Mask.Height;
            if Col < Mask.Height then Alpha := Alpha * (Col / Mask.Height)
            else if Col > Mask.Width - Mask.Height then
            begin
              Alpha := Alpha * ((Mask.Width - Col) / Mask.Height);
            end;
          end;
        else
          begin
            Alpha := (Mask.Width - Col) / Mask.Width;
            if Row < Mask.Width then Alpha := Alpha * (Row / Mask.Width)
            else if Row > Mask.Height - Mask.Width then
            begin
              Alpha := 0;//Alpha * ((Mask.Height - Row) / Mask.Width);
            end;
          end;
      end;

      Alpha := Alpha * 0.20;

      { Convert 0-1 to 0-255 }
      AlphaByte := Round(Alpha * 255.0);

      { Set Alpha }
      Pixel.Alpha := AlphaByte;

      { Premultiply R, G & B }
      Pixel.Red := Round(Pixel.Red * Alpha);
      Pixel.Green := Round(Pixel.Green * Alpha);
      Pixel.Blue := Round(Pixel.Blue * Alpha);

      { Move to next Pixed }
      Inc(Pixel);

    end; { for Col }

  end; { for Row }

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, Inner.Left, Inner.Top);

  { Release }
  Mask.Free;
end;

procedure DrawSizeGrip(Canvas: TCanvas; GripRect: TRect; Color: TColor);
var
  X, Y: Integer;
begin
  X := GripRect.Right + 1;
  Y := GripRect.Bottom - 0;
  while X > GripRect.Left do
    with Canvas do
    begin
      Pen.Color := Color;
      Polyline([
        Point(X, GripRect.Bottom - 1),
        Point(GripRect.Right, Y)
      ]);
      Dec(X, 3);
      Dec(Y, 3);
    end;
end;

procedure DrawTextRect(Canvas: TCanvas; TextRect: TRect; Alignment: TAlignment;
  VertAlignment: TVerticalAlignment; Text: WideString; WrapKind: TNxWrapKind;
  AcceleratedChars: Boolean);
var
  Flags: Integer;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
  TextSize: TSize;
begin
  Flags := DT_EXTERNALLEADING;
  if not AcceleratedChars then Flags := Flags or DT_NOPREFIX;

  if WrapKind <> wkWordWrap then
  begin
    Flags := Flags or DT_SINGLELINE;
  end;

  { Vert Alignment }
  case VertAlignment of
    taAlignTop: Flags := Flags or DT_TOP;
    taAlignBottom: Flags := Flags or DT_BOTTOM;
    taVerticalCenter: Flags := Flags or DT_VCENTER;
  end;

  { Wrapping }
  case WrapKind of
    wkNone: ;
    wkEllipsis: Flags := Flags or DT_END_ELLIPSIS;
    wkPathEllipsis: Flags := Flags or DT_PATH_ELLIPSIS;
    wkWordEllipsis: Flags := Flags or DT_WORD_ELLIPSIS;
    wkWordWrap:
    begin
      Flags := Flags or DT_WORDBREAK or DT_TOP;
      if VertAlignment <> taAlignTop then
      begin
        TextSize := GetTextSize(Canvas.Handle, TextRect, Text);
        case VertAlignment of
          taVerticalCenter: OffsetRect(TextRect, 0, Floor(RectHeight(TextRect) / 2 - TextSize.cy / 2));
          taAlignBottom: TextRect.Top := TextRect.Bottom - RectHeight(TextRect);
        end;
      end;
    end;
  end;

  { Horz Alignment }
  case Alignment of
    taLeftJustify: Flags := Flags or DT_LEFT;
    taRightJustify: Flags := Flags or DT_RIGHT;
    Classes.taCenter: Flags := Flags or DT_CENTER;
  end;

  { Draw Text }
  with Canvas.Brush do
  begin
    Style := bsClear;
    case UnicodeSupported of
      True: DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
      else
      begin
        {$IFDEF UNICODE}
        DrawText(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Canvas.Handle, PAnsiChar(StringText), Length(StringText), TextRect, Flags);
        {$ENDIF}
      end;
    end;
    Style := bsSolid;
  end;
end;

procedure DrawVerticalText(Canvas: TCanvas; Rect: TRect;
  Text: WideString; MultiLine: Boolean);
var
  LogRec: TLOGFONT;
  OldFont, NewFont: HFONT;
  Flags: Integer;
  StringList: TStringlist;
  i, H: Integer;
  s: string;
begin
  Flags := DT_NOPREFIX or DT_BOTTOM or DT_EXTERNALLEADING or DT_SINGLELINE;
  with Canvas do
  begin
    Brush.Style := bsClear;
    GetObject(Font.Handle, SizeOf(LogRec), @LogRec);
    LogRec.lfEscapement := 900;
    LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
    NewFont := CreateFontIndirect(LogRec);
    OldFont := SelectObject(Canvas.Handle, NewFont);
    if (Pos(#13, Text) = 0) or not MultiLine then
    begin
      DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
    end else
    begin
      // Windows.DrawText has a bug that can't handle multiple lines in non-horizontal orientation.
      // See http://msdn.microsoft.com/en-us/library/dd162498(VS.85).aspx
      StringList := TStringlist.Create;
      StringList.Text := Text;
      H := TextHeight(Text);
      For i := 0 to StringList.Count - 1 do
      begin
        S := StringList.Strings[i];
        DrawTextW(Canvas.Handle, PWideChar(S), Length(S), Rect, Flags);
        Inc(Rect.Left, H);
      end;
      StringList.Free;
    end;
    NewFont := SelectObject(Canvas.Handle,OldFont);
    DeleteObject(NewFont);
  end;
end;

procedure DrawVertTextRect(Canvas: TCanvas; TextRect: TRect; Alignment: TAlignment;
  VertAlignment: TVerticalAlignment; Text: WideString; WrapKind: TNxWrapKind);
var
  LogRec: TLOGFONT;
  OldFont, NewFont: HFONT;
  Flags: Integer;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
begin

  Flags := DT_NOPREFIX or DT_BOTTOM or DT_EXTERNALLEADING or DT_SINGLELINE;

  GetObject(Canvas.Font.Handle, SizeOf(LogRec), @LogRec);
  LogRec.lfEscapement := 900;
  LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;

  Inc(TextRect.Bottom, Abs(LogRec.lfHeight));

  NewFont := CreateFontIndirect(LogRec);
  OldFont := SelectObject(Canvas.Handle, NewFont);

  { Vert Alignment }
  case VertAlignment of
    taAlignTop: Flags := Flags or DT_TOP;
    taAlignBottom: Flags := Flags or DT_BOTTOM;
    taVerticalCenter: Flags := Flags or DT_VCENTER;
  end;

  { Wrapping }
  case WrapKind of
    wkNone: ;
    wkEllipsis: Flags := Flags or DT_END_ELLIPSIS;
    wkPathEllipsis: Flags := Flags or DT_PATH_ELLIPSIS;
    wkWordEllipsis: Flags := Flags or DT_WORD_ELLIPSIS;
    wkWordWrap: Flags := Flags or DT_WORDBREAK;
  end;

  { Horz Alignment }
  case Alignment of
    taLeftJustify: Flags := Flags or DT_LEFT;
    taRightJustify: Flags := Flags or DT_RIGHT;
    Classes.taCenter: Flags := Flags or DT_CENTER;
  end;

  { Draw Text }
  with Canvas.Brush do
  begin
    Style := bsClear;
    case UnicodeSupported of
      True: DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
      else
      begin
        {$IFDEF UNICODE}
        DrawText(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Canvas.Handle, PAnsiChar(StringText), Length(StringText), TextRect, Flags);
        {$ENDIF}
      end;
    end;
    Style := bsSolid;
  end;

  NewFont := SelectObject(Canvas.Handle, OldFont);
  DeleteObject(NewFont);
end;

procedure DrawTextOut(Canvas: TCanvas; X, Y: Integer; Text: WideString);
var
  Flags: Integer;
  TextRect: TRect;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
begin
  TextRect := Bounds(X, Y, 0, 0);

  Flags := DT_NOPREFIX or DT_EXTERNALLEADING or DT_TOP or DT_NOCLIP
    or DT_SINGLELINE or DT_LEFT;

  { Draw Text }
  with Canvas.Brush do
  begin
    Style := bsClear;
    case UnicodeSupported of
      True: DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
      else
      begin
        {$IFDEF UNICODE}
        DrawText(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Canvas.Handle, PAnsiChar(StringText), Length(StringText), TextRect, Flags);
        {$ENDIF}
      end;
    end;
    Style := bsSolid;
  end;
end;

procedure DrawEllipsis(Canvas: TCanvas; Rect: TRect; BrushColor: TColor);
var
  Pos: TPoint;
  DotRect: TRect;
begin
  { Calc. Center }
  Pos := PosInRect(15, 3, Rect, Classes.taCenter, taVerticalCenter);

  { Draw Dots }
  with Canvas do
  begin
    Brush.Color := BrushColor;

    DotRect := Bounds(Pos.X, Pos.Y, 3, 3);
    FillRect(DotRect);

    OffsetRect(DotRect, 6, 0);
    FillRect(DotRect);

    OffsetRect(DotRect, 6, 0);
    FillRect(DotRect);
  end;
end;

procedure DrawDetailsMark(Canvas: TCanvas; const X, Y: Integer; Color: TColor);
begin
  with Canvas do
  begin
    Pen.Color := Color;
    Brush.Color := Color;

    Polyline([
      Point(X, Y + 5),
      Point(X, Y),
      Point(X + 6, Y)
    ]);

    Polygon([
      Point(X + 3, Y + 6),
      Point(X + 6, Y + 3),
      Point(X + 6, Y + 6)
    ]);

    Polyline([
      Point(X + 3, Y + 3),
      Point(X + 5, Y + 5)
    ]);
  end;
end;

procedure DrawDropDownMark(Canvas: TCanvas; const X, Y: Integer; Color: TColor);
begin
  with Canvas do
  begin
    Pen.Color := clBlack;
    Brush.Color := Pen.Color;
    Polygon([
      Point(X, Y),
      Point(X + 4, Y + 4),
      Point(X + 8, Y)
    ]);
  end;
end;

procedure DrawPlus(Canvas: TCanvas; PlusRect: TRect; BrushColor: TColor);
var
  Pos: TPoint;
  BarRect: TRect;
begin
  { Calc. Center }
  Pos := PosInRect(13, 13, PlusRect, Classes.taCenter, taVerticalCenter);

  { Draw Dots }
  with Canvas do
  begin
    Brush.Color := BrushColor;

    BarRect := Rect(Pos.X + 5, Pos.Y, Pos.X + 8, Pos.Y + 13);
    FillRect(BarRect);

    BarRect := Rect(Pos.X, Pos.Y + 5, Pos.X + 13, Pos.Y + 8);
    FillRect(BarRect);
  end;
end;

procedure DrawIndicatorArrow(Canvas: TCanvas; Rect: TRect; Color: TColor);
var
  MX, MY: Integer;
begin
  with Canvas do
  begin
    MX := Rect.Left + RectWidth(Rect) div 2;
    MY := Rect.Top + RectHeight(Rect) div 2;
    Pen.Color := Color;
    Brush.Color := Color;
    Polygon([
      Point(Rect.Left, Rect.Top),
      Point(MX, MY),
      Point(Rect.Left, Rect.Bottom - 1),
      Point(MX, Rect.Bottom - 1),
      Point(Rect.Right - 1, MY),
      Point(MX, Rect.Top),
      Point(Rect.Left, Rect.Top)
    ]);
  end;
end;

procedure DrawSortArrow(Canvas: TCanvas; const X, Y: Integer; SortKind: TNxSortKind);
begin

end;

procedure FadeHorz(Canvas: TCanvas; SourceRect: TRect;
  InvertDirection: Boolean);
var
  Row, Col: Integer;
  Alpha: Single;
  Pixel: PQuadColor;
  AlphaByte: Byte;
  Mask: TBitmap;
begin
  Mask := TBitmap.Create;

  { Used for AlphaBlend Func }
  with Mask do
  begin
    PixelFormat := pf32bit;
    Width := RectWidth(SourceRect);;
    Height := RectHeight(SourceRect);
  end;

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    for Col := 0 to Pred(Mask.Width) do
    begin
      { Alpha Level }
      Alpha := Col / Mask.Width; // 0 - 1 of how far along the row this is
      if InvertDirection then Alpha := 1 - Alpha;

      AlphaByte := Round(Alpha * 255.0); { Convert 0 - 1 to 0 - 255 }

      { Alpha Channel }
      Pixel.Alpha := AlphaByte;

      { Premultiply R, G & B }
      Pixel.Red := Round(Pixel.Red * Alpha);
      Pixel.Green := Round(Pixel.Green * Alpha);
      Pixel.Blue := Round(Pixel.Blue * Alpha);

      { Move to next Pixed }
      Inc(Pixel);
    end;
  end;

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, SourceRect.Left, SourceRect.Top);

  { Destroy TBitmap }
  Mask.Free;
end;

procedure FadeVert(Canvas: TCanvas; SourceRect: TRect);
var
  Row, Col: Integer;
  Alpha: Single;
  Pixel: PQuadColor;
  AlphaByte: Byte;
  Mask: TBitmap;
begin
  { 10/26/11: We create an Alpha Mask TBitmap here which
              will be aplied into Canvas }
  Mask := TBitmap.Create;

  with Mask do
  begin
    { Important for AlphaBlend Func }
    PixelFormat := pf32bit;
    Width := SourceRect.Right - SourceRect.Left;
    Height := SourceRect.Bottom - SourceRect.Top;
  end;

  for Row := 0 to Pred(Mask.Height) do
  begin
    { Read first Pixel in row }
    Pixel := Mask.Scanline[Row];

    { Determine Alpha Level }
    Alpha := Row / Mask.Height; // 0-1 of how far along the row this is

    AlphaByte := Round(Alpha * 255.0); { Convert 0-1 to 0-255 }

    for Col := 0 to Pred(Mask.Width) do
    begin
      { Alpha Channel }
      Pixel.Alpha := AlphaByte;

      { Premultiply R, G & B }
      Pixel.Red := Round(Pixel.Red * Alpha);
      Pixel.Green := Round(Pixel.Green * Alpha);
      Pixel.Blue := Round(Pixel.Blue * Alpha);

      { Move to next Pixed }
      Inc(Pixel);
    end;
  end;

  { Call Blending Func }
  AlphaBlend(Canvas, Mask, SourceRect.Left, SourceRect.Top);

  { Destroy TBitmap }
  Mask.Free;
end;

procedure FlipVert(Source: TBitmap);
var
  Col, Row: integer;
  PixelSrc, PixelDest: PQuadColor;
begin
  for Row := 0 to Pred(Source.Height) do
  begin
    PixelSrc := Source.ScanLine[Row];;
    PixelDest := Source.ScanLine[Source.Height - 1 - Row];
    for Col := 0 to Pred(Source.Width) do
    begin
      PixelSrc.Red := PixelDest.Red;
      PixelSrc.Green := PixelDest.Green;
      PixelSrc.Blue := PixelDest.Blue;

      Inc(PixelSrc);
      Inc(PixelDest);
    end;
  end;
end;

function BlendColor(Color1, Color2: TColor; Amount: Byte): TColor;
var
  Value: Cardinal;
begin
  Assert(Amount in [0..255]);
  Value := Amount xor 255;
  if Integer(Color1) < 0 then Color1 := GetSysColor(Color1 and $000000FF);
  if Integer(Color2) < 0 then Color2 := GetSysColor(Color2 and $000000FF);
  Result := Integer(
    ((Cardinal(Color1) and $FF00FF) * Cardinal(Amount) +
    (Cardinal(Color2) and $FF00FF) * Value) and $FF00FF00 +
    ((Cardinal(Color1) and $00FF00) * Cardinal(Amount) +
    (Cardinal(Color2) and $00FF00) * Value) and $00FF0000) shr 8;
end;

function ColorToWebColor(Color: TColor): string;
var
  RealColor: TColorRef;
begin
  RealColor := ColorToRGB(Color);
  Result := Format('#%.2x%.2x%.2x', [GetRValue(RealColor), GetGValue(RealColor), GetBValue(RealColor)]);
end;

function DelphiColorToColor(DelphiColor: string): TColor;
var
  i: Integer;
begin
  { Default }
  Result := clNone;

  { Search for Color }
  for i := 0 to Pred(High(DelphiColorNames)) do
    if CompareText(DelphiColorNames[i], DelphiColor) = EqualsValue then
    begin
      Result := StringToColor(DelphiColor);

      Exit; { Done }
    end;

end;

procedure EraseBackground(Control: TCustomControl; Canvas: TCanvas);
var
  Shift, Pt: TPoint;
  DC: HDC;
begin
  if Control.Parent = nil then Exit;
  if Control.Parent.HandleAllocated then
  begin
    DC := Canvas.Handle;
    Shift.X := 0;
    Shift.Y := 0;
    Shift := Control.Parent.ScreenToClient(Control.ClientToScreen(Shift));
    SaveDC(DC);
    try
      OffsetWindowOrgEx(DC, Shift.X, Shift.Y, nil);
      GetBrushOrgEx(DC, Pt);
      SetBrushOrgEx(DC, Pt.X + Shift.X, Pt.Y + Shift.Y, nil);
      Control.Parent.Perform(WM_ERASEBKGND, WParam(DC), 0);
      Control.Parent.Perform(WM_PAINT, WParam(DC), 0);
    finally
      RestoreDC(DC, -1);
    end;
  end;
end;

function WebColorToColor(WebColor: string): TColor;
begin
  try
    { Delete "#" Char }
    Delete(WebColor, 1, 1);

    { Alpha Channel }
    WebColor := '$00' + WebColor;

    Result := StringToColor(WebColor);

    { Swap Red & Blue }
    Result := (((Result and $ff) shl 16) + (Result and $ff00) + (Result and $ff0000) shr 16);
  except
    Result := clNone;
  end;
end;

function WebColorName(Value: string): string;
var
  AColorName: TWebColor;
  i : integer;
begin
  Result := EmptyStr;

  for i := 0 to 140 do
  begin
    AColorName := WebColors[i];

    if LowerCase(AColorName[cnColorValue]) = LowerCase(Value) then
    begin
      Result := AColorName[cnColorName];

      Exit; { Done }
    end;
  end;
end;

function WebColorValue(Color: string): string;
var
  i: Integer;
  ColorName: TWebColor;
begin
  Result := EmptyStr;

  for i := 0 to 140 do
  begin
    ColorName := WebColors[i];

    if LowerCase(ColorName[cnColorName]) = LowerCase(Color) then
    begin
      Result := ColorName[cnColorValue];

      Exit;
    end;
  end;

end;

procedure GetRGB(C: TColor; out R, G, B: Byte);
begin
  if Integer(C) < 0 then C := GetSysColor(C and $000000FF);
  R := C and $FF;
  G := C shr 8 and $FF;
  B := C shr 16 and $FF;
end;

function GetSystemColor(Color: TColor): TColor;
begin
  if Integer(Color) < 0 then
    Result := GetSysColor(Color and $000000FF)
  else
    Result := Color;
end;

function HTMLColorToString(Color: TColor): string;
begin
  if Integer(Color) < 0 then Color := GetSysColor(Color and $000000FF);
  Result := '#' + IntToHex(((Color and $ff) shl 16) + (Color and $ff00) + (Color and $ff0000) shr 16, 6);
end;

function ColorNameToColor(S: string): TColor;
begin
  { Try web }
  Result := WebColorToColor(WebColorValue(S));

  { Try delphi }
  if Result = clNone then Result := StringToColor(S);// DelphiColorToColor(S);
end;

function DarkerColor(Color: TColor; Percent: Byte): TColor;
var
  r, g, b: Byte;
begin
  Color := ColorToRGB(Color);
  r := GetRValue(Color);
  g := GetGValue(Color);
  b := GetBValue(Color);
  r := r - MulDiv(r, Percent, 100); //Percent% closer to black
  g := g - MulDiv(g, Percent, 100);
  b := b - MulDiv(b, Percent, 100);
  Result := RGB(r, g, b);
end;

function IsColorLight(Color: TColor): Boolean;
begin
  Color := ColorToRGB(Color);
  Result := ((Color and $FF) + (Color shr 8 and $FF) + (Color shr 16 and $FF))>= $180;
end;

function LighterColor(Color: TColor; Percent: Byte): TColor;
var
  r, g, b: Byte;
begin
  Color := ColorToRGB(Color);
  r := GetRValue(Color);
  g := GetGValue(Color);
  b := GetBValue(Color);
  r := r + MulDiv(255 - r, Percent, 100);
  g := g + MulDiv(255 - g, Percent, 100);
  b := b + MulDiv(255 - b, Percent, 100);
  Result := RGB(r, g, b);
end;

function ColorBrightness(const Color: TColor ): byte;
var
  r, g, b: byte;
begin
  r := Color and $FF;
  g := (Color shr 8) and $FF;
  b := (Color shr 16) and $FF;
  Result := (Max(Max(r, g), b) + Min(Min(r, g), b)) div 2;
end;

procedure ConstrainedRect(Graphic: TGraphic; var Src: TRect);
var
  ScaleHor, ScaleVer, Scale: Double;
  NewWidth, NewHeight, ATop, ALeft: Integer;
begin
  ScaleHor := (Src.Right - Src.Left) / Graphic.Width;
  ScaleVer := (Src.Bottom - Src.Top) / Graphic.Height;
  Scale := Math.Min(ScaleHor, ScaleVer);
  NewWidth  := Round(Graphic.Width * Scale);
  NewHeight := Round(Graphic.Height * Scale);

  if ScaleHor < ScaleVer then
  begin
    NewWidth := Src.Right - Src.Left;
    ATop := Src.Top + ((Src.Bottom - Src.Top) div 2 - (NewHeight div 2));
    Src := Rect(Src.Left, ATop, Src.Left + NewWidth, ATop + NewHeight);
  end else
  begin
    NewHeight := Src.Bottom - Src.Top;
    ALeft := Src.Left + ((Src.Right - Src.Left) div 2 - (NewWidth div 2));
    Src := Rect(ALeft, Src.Top, ALeft + NewWidth, Src.Top + NewHeight);
  end;
end;

function GetTextHeight(Canvas: TCanvas; Width: Integer; Text: WideString): Integer;
begin
  Result := GetTextSize(Canvas.Handle, Rect(0, 0, Width, 0), Text).cy;
end;

function GetTextHeight(Canvas: TCanvas; Width: Integer; Text: WideString; WrapKind: TNxWrapKind): Integer;
var
  Flags: Integer;
  TextRect: TRect;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
begin
  Flags := DT_NOPREFIX or DT_VCENTER or DT_EXTERNALLEADING or DT_CALCRECT;
  case WrapKind of
    wkNone: ;
    wkEllipsis: Flags := Flags or DT_END_ELLIPSIS;
    wkPathEllipsis: Flags := Flags or DT_PATH_ELLIPSIS;
    wkWordWrap: Flags := Flags or DT_WORDBREAK;
  end;
  TextRect := Rect(0, 0, Width, 0);
  case UnicodeSupported of
    True:
      DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
    False:
      begin
        {$IFDEF UNICODE}
        DrawText(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Canvas.Handle, PAnsiChar(StringText), Length(StringText), TextRect, Flags);
        {$ENDIF}
      end;
  end;
  Result := TextRect.Bottom - TextRect.Top;
end;

function GetTextHeight(Canvas: TCanvas; Text: WideString; WordWrap: Boolean): Integer; overload;
var
  Flags: Integer;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
  CalcRect: TRect;
begin
  Flags := DT_NOPREFIX or DT_EXTERNALLEADING or DT_CALCRECT;

  if not WordWrap then Flags := Flags or DT_SINGLELINE;

  case UnicodeSupported of
    True:
      DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), CalcRect, Flags);
    False:
      begin
        {$IFDEF UNICODE}
        DrawText(Canvas.Handle, PWideChar(Text), Length(Text), CalcRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Canvas.Handle, PAnsiChar(StringText), Length(StringText), CalcRect, Flags);
        {$ENDIF}
      end;
  end;

  Result := CalcRect.Bottom - CalcRect.Top;
end;

function GetTextWidth(Canvas: TCanvas; Text: WideString; FixedWidth: Integer): Integer;
var
  Flags: Integer;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
  CalcRect: TRect;
begin
  Flags := DT_NOPREFIX or DT_EXTERNALLEADING or DT_CALCRECT or DT_WORDBREAK;

  CalcRect := Bounds(0, 0, FixedWidth, 0);

  case UnicodeSupported of
    True:
      DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), CalcRect, Flags);
    False:
      begin
        {$IFDEF UNICODE}
        DrawText(Canvas.Handle, PWideChar(Text), Length(Text), CalcRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Canvas.Handle, PAnsiChar(StringText), Length(StringText), CalcRect, Flags);
        {$ENDIF}
      end;
  end;

  Result := CalcRect.Right - CalcRect.Left;
end;

function GetTextWidth(Canvas: TCanvas; Text: WideString; WrapKind: TNxWrapKind): Integer;
var
  Flags: Integer;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
  CalcRect: TRect;
begin
  Flags := DT_NOPREFIX or DT_EXTERNALLEADING or DT_CALCRECT;

  CalcRect := Bounds(0, 0, 0, 0);

  case UnicodeSupported of
    True:
      DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), CalcRect, Flags);
    False:
      begin
        {$IFDEF UNICODE}
        DrawText(Canvas.Handle, PWideChar(Text), Length(Text), CalcRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Canvas.Handle, PAnsiChar(StringText), Length(StringText), CalcRect, Flags);
        {$ENDIF}
      end;
  end;

  Result := CalcRect.Right - CalcRect.Left;
end;

function GetTextMetric(Canvas: TCanvas): TTextMetric;
begin
  GetTextMetrics(Canvas.Handle, Result);
end;

function GetTextSize(Handle: HDC; TextRect: TRect; Text: WideString): TSize;
var
  Flags: Integer;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
begin
  Flags := DT_NOPREFIX or DT_VCENTER or DT_END_ELLIPSIS or DT_EXTERNALLEADING
    or DT_CALCRECT or DT_WORDBREAK;
  case UnicodeSupported of
    True:
      DrawTextW(Handle, PWideChar(Text), Length(Text), TextRect, Flags);
    False:
      begin
        {$IFDEF UNICODE}
        DrawText(Handle, PWideChar(Text), Length(Text), TextRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Handle, PAnsiChar(StringText), Length(StringText), TextRect, Flags);
        {$ENDIF}
      end;
  end;
  with Result do
  begin
    cx := TextRect.Right - TextRect.Left;
    cy := TextRect.Bottom - TextRect.Top;
  end;
end;

function GetTextSize(Handle: HDC; TextRect: TRect; Text: WideString; WrapKind: TNxWrapKind): TSize;
var
  Flags: Integer;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
begin
  Flags := DT_NOPREFIX or DT_EXTERNALLEADING or DT_CALCRECT;
  case WrapKind of
    wkNone, wkEllipsis, wkPathEllipsis: Flags := Flags or DT_SINGLELINE;
    wkWordWrap: Flags := Flags or DT_WORDBREAK;
  end;
  case UnicodeSupported of
    True:
      DrawTextW(Handle, PWideChar(Text), Length(Text), TextRect, Flags);
    False:
      begin
        {$IFDEF UNICODE}
        DrawText(Handle, PWideChar(Text), Length(Text), TextRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Handle, PAnsiChar(StringText), Length(StringText), TextRect, Flags);
        {$ENDIF}
      end;
  end;
  with Result do
  begin
    cx := TextRect.Right - TextRect.Left;
    cy := TextRect.Bottom - TextRect.Top;
  end;
end;

function GetTextSize(Canvas: TCanvas; Text: WideString; NoPrefix: Boolean): TSize;
var
  Flags: Integer;
  TextRect: TRect;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
begin
  Flags := DT_CALCRECT or DT_SINGLELINE;
  if NoPrefix then Flags := Flags or DT_NOPREFIX;
  case UnicodeSupported of
    True: DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
    False:
      begin
{$IFDEF UNICODE}
        DrawText(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
{$ELSE}
        StringText := Text;
        DrawText(Canvas.Handle, PAnsiChar(StringText), Length(StringText), TextRect, Flags);
{$ENDIF}
      end;
  end;
  with Result do
  begin
    cx := TextRect.Right - TextRect.Left;
    cy := TextRect.Bottom - TextRect.Top;
  end;
end;

function RandomColor: TColor;
begin
  Randomize;
  Result := RGB(Random(255), Random(255), Random(255));
end;

function RectInRect(Container, Target: TRect): Boolean;
begin
  Result := PtInRect(Container, Target.TopLeft)
    and PtInRect(Container, Point(Pred(Target.Right), Pred(Target.Bottom)));
end;

function RectIntersect(Rect1, Rect2: TRect): Boolean;
begin
  Result := not((Rect1.Right < Rect2.Left) or (Rect1.Left > Rect2.Right) or
    (Rect1.Bottom < Rect2.Top) or (Rect1.Top > Rect2.Bottom));
end;

procedure SetFontQuality(Font: TFont; Quality: Byte);
var
  LogFont: TLogFont;
begin
  if GetObject(Font.Handle, SizeOf(TLogFont), @LogFont) = 0 then
    RaiseLastOSError;
  LogFont.lfQuality := Quality;
  Font.Handle := CreateFontIndirect(LogFont);
end;

function StrToColor(S: string): TColor;
var
  C: string;
  LColor: LongInt;
begin
  { Default }
  Result := clNone;

  if S <> EmptyStr then
  begin
    if LeftStr(S, 1) = '#'
      then Result := WebColorToColor(S)
    else if LeftStr(S, 1) = '$'
      then Result := StringToColor(S)
    else
    begin
      { Web Color }
      C := WebColorValue(S);
      if C <> '' then Result := WebColorToColor(C);

      { Standard Color }
      if Result = clNone then
        if IdentToColor(S, LColor)
          then Result := TColor(LColor)
          else Result := StrToIntDef(S, clNone);
    end
  end;
end;

procedure PaintEffects(Canvas: TCanvas; Dest: TRect; Effects: TNxPaintEffects);
begin
  if efInnerShadow in Effects then
  begin
    { Add inner shadow at top & left }
    DrawInnerShadows(Canvas, Dest, szInnerShadowSize);
  end;

  if efBevel in Effects then
  begin
    { Draw bevel on all sides }
    DrawBevels(Canvas, Dest, szBevelSize);
  end;

  if efShadow in Effects then
  begin
    { Add right & bottom shadow }
    DrawShadows(Canvas, Dest, szDropShadowSize);
  end;

  if efLight in Effects then
  begin
    DrawLight(Canvas, Dest, szReflectionSize);
  end;

  if efReflection in Effects then
  begin
    DrawReflection(Canvas, Dest, szReflectionSize);
  end;
end;

function PosInRect(Width, Height: Integer; Container: TRect;
  Alignment: TAlignment; VerticalAlignment: TVerticalAlignment): TPoint;
begin
  case Alignment of
    taLeftJustify: Result.X := Container.Left;
    taRightJustify: Result.X := Container.Right - Width;
    Classes.taCenter: Result.X := CenterPoint(Container).X - Floor(Width / 2);
  end;
  case VerticalAlignment of
    taAlignTop: Result.Y := Container.Top;
    taAlignBottom: Result.Y := Container.Bottom - Height;
    taVerticalCenter: Result.Y := CenterPoint(Container).Y - Floor(Height / 2);
  end;
end;

procedure SetClipRect(Canvas: TCanvas; ClipRect: TRect);
var
  CLPRGN: HRGN;
  P: TPoint;
begin
  { TODO: use RectVisible WinApi }
  with ClipRect do
    CLPRGN := CreateRectRgn(Left, Top, Right, Bottom);
    try
      GetWindowOrgEx(Canvas.Handle, P);
      OffsetRgn(CLPRGN, -P.X, -P.Y);

      SelectClipRgn(Canvas.Handle, CLPRGN);
    finally
      DeleteObject(CLPRGN);
    end;
end;

procedure ExcludeClipRect(Canvas: TCanvas; ClipRect: TRect);
begin
  with ClipRect do Windows.ExcludeClipRect(Canvas.Handle, Left, Top, Left + (Right - Left), Top + (Bottom - Top));
end;

procedure FillPadding(Canvas: TCanvas; Color: TColor; Dest: TRect; Padding: TPadding);
begin
  with Canvas, Padding do
  begin
    Brush.Color := Color;

    FillRect(Rect(Dest.Left + Left, Dest.Top, Dest.Right - Right, Dest.Top + Top));
    FillRect(Rect(Dest.Left, Dest.Top, Dest.Left + Left, Dest.Bottom));
    FillRect(Rect(Dest.Right - Right, Dest.Top, Dest.Right, Dest.Bottom));
    FillRect(Rect(Dest.Left + Left, Dest.Bottom - Bottom, Dest.Right - Right, Dest.Bottom));
  end;
end;

function FitToRect(Source, Destination: TRect): TRect;
begin
  Result := Source;
  with Result do
  begin
    if Result.Left < Destination.Left then Result.Left := Destination.Left;
    if Result.Top < Destination.Top then Result.Top := Destination.Top;
    if Result.Right > Destination.Right then Result.Right := Destination.Right;
    if Result.Bottom > Destination.Bottom then Result.Bottom := Destination.Bottom;
  end;
end;

function PaintGraphic(Canvas: TCanvas; Graphic: TGraphic;
  Dest: TRect; FillMode: TNxFillMode): TRect;
var
  ClipRect: TRect;

  procedure DrawAspectFillPicture;
  var
    GraphicRect: TRect;
  begin
    GraphicRect := Bounds(0, 0, Graphic.Width, Graphic.Height);
    GraphicRect := CenteredRect(Dest, GraphicRect);

    if RectWidth(Result) > RectWidth(GraphicRect) then
    begin
      Result.Left := GraphicRect.Left;
      Result.Right := GraphicRect.Right;
    end;

    if RectHeight(Result) > RectHeight(GraphicRect) then
    begin
      Result.Top := GraphicRect.Top;
      Result.Bottom := GraphicRect.Bottom;
    end;

    SetClipRect(Canvas, Result);
    Canvas.Draw(GraphicRect.Left, GraphicRect.Top, Graphic);
  end;

  procedure DrawConstrainedPicture;
  var
    ScaleHor, ScaleVer, Scale: Double;
    NewWidth, NewHeight, ATop, ALeft: Integer;
  begin
    with Dest do
    begin
      ScaleHor := (Right - Left) / Graphic.Width;
      ScaleVer := (Bottom - Top) / Graphic.Height;
      Scale := Min(ScaleHor, ScaleVer);

      NewWidth  := Round(Graphic.Width * Scale);
      NewHeight := Round(Graphic.Height * Scale);

      if ScaleHor < ScaleVer then
      begin
        NewWidth := Right - Left;
        ATop := Top + ((Bottom - Top) div 2 - (NewHeight div 2));
        Result := Rect(Left, ATop, Left + NewWidth, ATop + NewHeight);
      end else
      begin
        NewHeight := Bottom - Top;
        ALeft := Left + ((Right - Left) div 2 - (NewWidth div 2));
        Result := Rect(ALeft, Top, ALeft + NewWidth, Top + NewHeight);
      end;
      Canvas.StretchDraw(Result, Graphic);
    end;
  end;

  procedure DrawCenterPicture;
  begin
    Result := CenteredRect(Dest, Bounds(0, 0, Graphic.Width, Graphic.Height));

    SetClipRect(Canvas, Dest);
    Canvas.Draw(Result.Left, Result.Top, Graphic);

    Result := FitToRect(Result, Dest);
  end;

begin
  ClipRect := Canvas.ClipRect;
  Result := Dest;
  try
    case FillMode of
      fmAspectFit: DrawConstrainedPicture;
      fmAspectFill: DrawAspectFillPicture;
      fmCenter: DrawCenterPicture;
      fmScaleToFill: Canvas.StretchDraw(Dest, Graphic);
    end;
  finally
    SetClipRect(Canvas, ClipRect);
  end;
end;

function DotToPixel(Value: TRect): TRect; overload;
begin
  with Result do
  begin
    Left := Value.Left * (Screen.PixelsPerInch div 72);
    Top := Value.Top * (Screen.PixelsPerInch div 72);
    Right := Value.Right * (Screen.PixelsPerInch div 72);
    Bottom := Value.Bottom * (Screen.PixelsPerInch div 72);
  end;
end;

function DotToPixel(Value: TSize): TSize; overload;
begin
  with Result do
  begin
    cx := Value.cx * (Screen.PixelsPerInch div 72);
    cy := Value.cy * (Screen.PixelsPerInch div 72);
  end;
end;

function DotToPixel(Value: Integer): Integer; overload;
begin
  Result := MulDiv(Value, Screen.PixelsPerInch, 96);
end;

function DeviceIndipendedPoint(Value: Integer): Integer; overload;
begin
  Result := MulDiv(Value, Screen.PixelsPerInch, 96);
end;

function DeviceIndipendedPoint(Value: TPadding): TPadding; overload;
begin
  Result := Value;
  Result.Left := Value.Left * (Screen.PixelsPerInch div 72);
  Result.Top := Value.Top * (Screen.PixelsPerInch div 72);
  Result.Right := Value.Right * (Screen.PixelsPerInch div 72);
  Result.Bottom := Value.Bottom * (Screen.PixelsPerInch div 72);
end;

procedure OffsetRectPt(var lprc: TRect; dx, dy: Integer);
begin
  OffsetRect(lprc, MulDiv(dx, Screen.PixelsPerInch, 96), MulDiv(dy, Screen.PixelsPerInch, 96));
end;

function DpiScalePadding(Value: TPadding): TIndentation;
begin
  with Result do
  begin
    Leading := MulDiv(Value.Left, Screen.PixelsPerInch, 96);
    Trailing := MulDiv(Value.Right, Screen.PixelsPerInch, 96);
    Above := MulDiv(Value.Top, Screen.PixelsPerInch, 96);
    Bellow := MulDiv(Value.Bottom, Screen.PixelsPerInch, 96);
  end;
end;

function ScalePadding(Value: TPadding): TInsets;
begin
  with Result do
  begin
    Left := MulDiv(Value.Left, Screen.PixelsPerInch, 96);
    Right := MulDiv(Value.Right, Screen.PixelsPerInch, 96);
    Top := MulDiv(Value.Top, Screen.PixelsPerInch, 96);
    Bottom := MulDiv(Value.Bottom, Screen.PixelsPerInch, 96);
  end;
end;

procedure InflateRectScaled(var lprc: TRect; Padding: TPadding);
begin
  with lprc do
  begin
    Inc(Left, MulDiv(Padding.Left, Screen.PixelsPerInch, 96));
    Inc(Top, MulDiv(Padding.Top, Screen.PixelsPerInch, 96));
    Dec(Right, MulDiv(Padding.Right, Screen.PixelsPerInch, 96));
    Dec(Bottom, MulDiv(Padding.Bottom, Screen.PixelsPerInch, 96));
  end;
end;

procedure ScalePoints(Start: Integer; Points: array of TPoint);
var
  i: Integer;
begin
  for i := Start to Pred(Length(Points)) do
  begin
    Points[i] := Point(MulDiv(Points[i].X, Screen.PixelsPerInch, 96), MulDiv(Points[i].Y, Screen.PixelsPerInch, 96));
  end;
end;

end.
