{********************************************************************}
{                                                                    }
{ written by TMS Software                                            }
{            copyright © 2013                                        }
{            Email : info@tmssoftware.com                            }
{            Web : http://www.tmssoftware.com                        }
{                                                                    }
{ The source code is given as is. The author is not responsible      }
{ for any possible damage done due to the use of this code.          }
{ The complete source code remains property of the author and may    }
{ not be distributed, published, given or sold in any form as such.  }
{ No parts of the source code can be included in any other component }
{ or application without written authorization of the author.        }
{********************************************************************}

unit FMX.TMSPopup;

interface

{$I TMSDEFS.INC}

{$IFDEF IOS}
{$DEFINE POPUPPANEL}
{$ENDIF}

{$IFDEF ANDROID}
{$DEFINE POPUPPANEL}
{$ENDIF}

uses
  Classes, SysUtils, Types, UITypes, FMX.Forms, FMX.Platform,
  FMX.Objects, FMX.Types, FMX.Dialogs, FMX.TMSBaseControl,
  FMX.TMSHTMLText, FMX.TMSBarButton, FMX.TMSBitmapContainer, FMX.Effects
  , FMX.Controls, UIConsts, FMX.Styles, FMX.StdCtrls, FMX.Layouts
  {$IFDEF DELPHIXE5_LVL}
  , FMX.Graphics
  {$ENDIF}
  ;

const
  MAJ_VER = 1; // Major version nr.
  MIN_VER = 5; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 2; // Build nr.

  // version history
  // v1.0.0.0 : First Release
  // v1.1.0.3 : Reorganized packages
  // v1.1.1.0 : New : support for update 4
  // v1.1.1.1 : Fixed : Issue with setting the focus on the form (Can be activated / deactivated with ShowActivated property)
  // v1.1.1.2 : Improved : TMSIOS define
  // v1.1.1.3 : Fixed : Issue with parent
  // v1.1.1.4 : New : support for update 4 hotfix 1
  // v1.1.1.5 : Fixed : Issue with ApplyPlacement for plTop/plTopCenter
  // v1.1.1.6 : Fixed : Issue with default values for ArrowHeight and ArrowWidth
  // v1.1.1.7 : Fixed : Access violation
  // v1.5.0.0 : New : support for XE4
  // v1.5.0.1 : Fixed : Issue with component already exists
  // v1.5.0.2 : Fixed : Floating point division by zero

type
  TProtectedControl = class(TControl);

  TTMSFMXPopupShapeArrowPosition = (paLeftTop, paLeftCenter, paLeftBottom,
    paTopLeft, paTopCenter, paTopRight, paRightTop, paRightCenter,
    paRightBottom, paBottomLeft, paBottomCenter, paBottomRight);

  TTMSFMXPopupShape = class(TRectangle)
  private
    FArrowPosition: TTMSFMXPopupShapeArrowPosition;
    FArrowHeight: Single;
    FArrowWidth: Single;
    procedure SetArrowPosition(const Value: TTMSFMXPopupShapeArrowPosition);
    procedure SetArrowHeight(const Value: Single);
    procedure SetArrowWidth(const Value: Single);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
    function GetPath: TPathData;
  published
    property ArrowPosition: TTMSFMXPopupShapeArrowPosition read FArrowPosition write SetArrowPosition default paTopCenter;
    property ArrowHeight: Single read FArrowHeight write SetArrowHeight;
    property ArrowWidth: Single read FArrowWidth write SetArrowWidth;
  end;

  TTMSFMXPopup = class;

  TTMSFMXPopupButton = class(TCollectionItem)
  private
    FOwner: TTMSFMXPopup;
    FPopupButton: TTMSFMXBarButton;
    FWidth: Single;
    FBitmapName: String;
    FKind: TTMSFMXBarButtonKind;
    FText: String;
    FShowImage: Boolean;
    FShowText: Boolean;
    FLayout: TTMSFMXBarButtonShapeLayout;
    procedure SetBitmapName(const Value: String);
    procedure SetKind(const Value: TTMSFMXBarButtonKind);
    procedure SetText(const Value: String);
    procedure SetWidth(const Value: Single);
    procedure SetShowImage(const Value: Boolean);
    procedure SetShowText(const Value: Boolean);
    procedure SetLayout(const Value: TTMSFMXBarButtonShapeLayout);
  protected
    property PopupButton: TTMSFMXBarButton read FPopupButton write FPopupButton;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    function Button: TTMSFMXBarButton;
  published
    property Width: Single read FWidth write SetWidth;
    property ShowImage: Boolean read FShowImage write SetShowImage default False;
    property ShowText: Boolean read FShowText write SetShowText default True;
    property Text: String read FText write SetText;
    property BitmapName: String read FBitmapName write SetBitmapName;
    property Kind: TTMSFMXBarButtonKind read FKind write SetKind default bkNormal;
    property Layout: TTMSFMXBarButtonShapeLayout read FLayout write SetLayout default slRectangle;
  end;

  TTMSFMXPopupButtons = class(TTMSFMXBaseCollection)
  private
    FOwner: TTMSFMXPopup;
    function GetItem(Index: Integer): TTMSFMXPopupButton;
    procedure SetItem(Index: Integer; const Value: TTMSFMXPopupButton);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TTMSFMXPopup);
    function Add: TTMSFMXPopupButton;
    function Insert(Index: Integer): TTMSFMXPopupButton;
    property Items[Index: Integer]: TTMSFMXPopupButton read GetItem write SetItem; default;
  end;

  TTMSFMXPopupButtonEvent = procedure(Sender: TObject; AButton: TTMSFMXPopupButton; AButtonShape: TTMSFMXBarButton) of object;

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXPopup = class(TTMSFMXBaseControl)
  private
    FCreating: Boolean;
    FDragTimer: TTimer;
    FDestroying: Boolean;
    FSaveParent, FSaveParentDetail: TFMXObject;
    {$IFDEF POPUPPANEL}
    FLt: TLayout;
    FPopupForm: TControl;
    {$ELSE}
    FPopupForm: TCustomForm;
    {$ENDIF}
    FDetailControl: TControl;
    FPlacementTarget: TControl;
    FPlacement: TPlacement;
    FPlacementRectangle: TBounds;
    FVerticalOffset: Single;
    FHorizontalOffset: Single;
    FStaysOpen: Boolean;
    FControlMargins: TBounds;
    FAutoPosition: Boolean;
    FArrowWidth: Single;
    FArrowHeight: Single;
    FArrowPosition: TTMSFMXPopupShapeArrowPosition;
    FHeaderText: String;
    FOnClosePopup: TNotifyEvent;
    FFooterText: String;
    FShowHeader: Boolean;
    FShowFooter: Boolean;
    FHeaderHeight: Single;
    FFooterHeight: Single;
    FHeaderButtons: TTMSFMXPopupButtons;
    FFooterButtons: TTMSFMXPopupButtons;
    FOnCustomizeFooterButton: TTMSFMXPopupButtonEvent;
    FOnCustomizeHeaderButton: TTMSFMXPopupButtonEvent;
    FBitmapContainer: TTMSFMXBitmapContainer;
    FDragWithParent: Boolean;
    FOnHeaderButtonClick: TTMSFMXPopupButtonEvent;
    FOnFooterButtonClick: TTMSFMXPopupButtonEvent;
    FEffectMargins: TBounds;
    FOnFooterAnchorClick: TTMSFMXHTMLTextAnchorClickEvent;
    FOnHeaderAnchorClick: TTMSFMXHTMLTextAnchorClickEvent;
    FShowActivated: Boolean;
    FTransparent: Boolean;
    FShadow: Boolean;
    FParentControl: TFMXObject;
    procedure SetPlacementRectangle(const Value: TBounds);
    procedure SetArrowHeight(const Value: Single);
    procedure SetArrowPosition(const Value: TTMSFMXPopupShapeArrowPosition);
    procedure SetArrowWidth(const Value: Single);
    procedure SetHeaderText(const Value: String);
    function GetVersion: String;
    function GetVersionNr: Integer;
    procedure SetVersion(const Value: String);
    procedure SetFooterText(const Value: String);
    procedure SetShowFooter(const Value: Boolean);
    procedure SetShowHeader(const Value: Boolean);
    procedure SetFooterHeight(const Value: Single);
    procedure SetHeaderHeight(const Value: Single);
    procedure SetFooterButtons(const Value: TTMSFMXPopupButtons);
    procedure SetHeaderButtons(const Value: TTMSFMXPopupButtons);
    procedure DoTimer(Sender: TObject);
    procedure SetDetailControl(const Value: TControl);
    procedure SetEffectMargins(const Value: TBounds);
    procedure SetTransparent(const Value: Boolean);
    function GetIsOpen: Boolean;
    procedure SetIsOpen(const Value: Boolean);
    procedure SetShadow(const Value: Boolean);
  protected
    function GetParentForm(AControl: TFMXObject = nil): TCommonCustomForm;
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure AssignEvents;
    procedure HeaderAnchorClick(Sender: TObject; AAnchor: String);
    procedure FooterAnchorClick(Sender: TObject; AAnchor: String);
    procedure HeaderButtonClick(Sender: TObject);
    procedure FooterButtonClick(Sender: TObject);
    procedure UpdatePopupShape;
    function IsDetailControlAdded(AControl: TFMXObject): Boolean;
    procedure DialogKey(var Key: Word; Shift: TShiftState); override;
    function GetInstance: NativeUInt; override;
    procedure DoFormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ApplyAutoPosition;
    procedure UpdateHeader;
    procedure UpdateFooter;
    procedure UpdateShadow;
    procedure UpdateHeaderPos;
    procedure UpdateFooterPos;
    procedure UpdateShape;
    procedure UpdateButtons;
    procedure CleanUpHeaderButtons;
    procedure CleanUpFooterButtons;
    function DoesHeaderButtonExist(AButtonName: String): TTMSFMXBarButton;
    function DoesFooterButtonExist(AButtonName: String): TTMSFMXBarButton;
    function GetHeader: TFMXObject;
    function GetFooter: TFMXObject;
    function GetHeaderText: TFMXObject;
    function GetFooterText: TFMXObject;
    function GetButton: TTMSFMXBarButton;
    function GetPopup: TFMXObject;
    procedure DoClose;
  public
    property ParentControl: TFMXObject read FParentControl write FParentControl;
    procedure ApplyStyle; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Resize; override;
    procedure Loaded; override;
    procedure Popup;
    procedure ClosePopup;
    {$IFDEF DELPHIXE6_LVL}
    procedure ShowPopup(AControl: TControl = nil; APlacement: TPlacement = TPlacement.Bottom);
    {$ELSE}
    procedure ShowPopup(AControl: TControl = nil; APlacement: TPlacement = TPlacement.plBottom);
    {$ENDIF}
    procedure HidePopup;
    procedure ApplyPlacement;
    property IsOpen: Boolean read GetIsOpen write SetIsOpen;
  published
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property Shadow: Boolean read FShadow write SetShadow default True;
    property EffectMargins: TBounds read FEffectMargins write SetEffectMargins;
    property AutoPosition: Boolean read FAutoPosition write FAutoPosition default True;
    property DetailControl: TControl read FDetailControl write SetDetailControl;
    {$IFDEF DELPHIXE6_LVL}
    property Placement: TPlacement read FPlacement write FPlacement default TPlacement.Bottom;
    {$ELSE}
    property Placement: TPlacement read FPlacement write FPlacement default TPlacement.plBottom;
    {$ENDIF}
    property PlacementTarget: TControl read FPlacementTarget write FPlacementTarget;
    property PlacementRectangle: TBounds read FPlacementRectangle write SetPlacementRectangle;
    property HorizontalOffset: Single read FHorizontalOffset write FHorizontalOffset;
    property VerticalOffset: Single read FVerticalOffset write FVerticalOffset;
    property StaysOpen: Boolean read FStaysOpen write FStaysOpen default False;
    property ShowActivated: Boolean read FShowActivated write FShowActivated default False;
    property BitmapContainer: TTMSFMXBitmapContainer read FBitmapContainer write FBitmapContainer;

    property HeaderButtons: TTMSFMXPopupButtons read FHeaderButtons write SetHeaderButtons;
    property FooterButtons: TTMSFMXPopupButtons read FFooterButtons write SetFooterButtons;
    property FooterText: String read FFooterText write SetFooterText;
    property HeaderText: String read FHeaderText write SetHeaderText;
    property FooterHeight: Single read FFooterHeight write SetFooterHeight;
    property HeaderHeight: Single read FHeaderHeight write SetHeaderHeight;
    property ShowHeader: Boolean read FShowHeader write SetShowHeader default True;
    property ShowFooter: Boolean read FShowFooter write SetShowFooter default True;
    property ArrowPosition: TTMSFMXPopupShapeArrowPosition read FArrowPosition write SetArrowPosition default paTopCenter;
    property ArrowHeight: Single read FArrowHeight write SetArrowHeight;
    property ArrowWidth: Single read FArrowWidth write SetArrowWidth;
    property OnClosePopup: TNotifyEvent read FOnClosePopup write FOnClosePopup;
    property Version: String read GetVersion write SetVersion;
    property DragWithParent: Boolean read FDragWithParent write FDragWithParent default True;

    property OnHeaderAnchorClick: TTMSFMXHTMLTextAnchorClickEvent read FOnHeaderAnchorClick write FOnHeaderAnchorClick;
    property OnFooterAnchorClick: TTMSFMXHTMLTextAnchorClickEvent read FOnFooterAnchorClick write FOnFooterAnchorClick;


    property OnHeaderButtonClick: TTMSFMXPopupButtonEvent read FOnHeaderButtonClick write FOnHeaderButtonClick;
    property OnFooterButtonClick: TTMSFMXPopupButtonEvent read FOnFooterButtonClick write FOnFooterButtonClick;
    property OnCustomizeHeaderButton: TTMSFMXPopupButtonEvent read FOnCustomizeHeaderButton write FOnCustomizeHeaderButton;
    property OnCustomizeFooterButton: TTMSFMXPopupButtonEvent read FOnCustomizeFooterButton write FOnCustomizeFooterButton;
  end;

implementation

{$R FMX.TMSPopup.res}

{ TTMSFMXPopup }

procedure TTMSFMXPopup.ApplyAutoPosition;
begin
  if not AutoPosition then
    Exit;
end;

procedure TTMSFMXPopup.ApplyPlacement;
var
  Target: TControl;
  AbsolutePos, LocalPos: TPointF;
  Pos: TPointF;
  MouseService: IFMXMouseService;
begin
  if not Assigned(FPopupForm) then
    Exit;

  TPlatformServices.Current.SupportsPlatformService(IFMXMouseService, IInterface(MouseService));

  try
    Target := PlacementTarget;

    if (Target = nil) and (Parent <> nil) and (Parent is TControl) then
      Target := TControl(Parent);
    if Target = nil then
    begin
      case Placement of
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Bottom:
        {$ELSE}
        TPlacement.plBottom:
        {$ENDIF}
          begin
            LocalPos := PointF(FPlacementRectangle.Left + HorizontalOffset, FPlacementRectangle.Bottom + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Top:
        {$ELSE}
        TPlacement.plTop:
        {$ENDIF}
          begin
            LocalPos := PointF(FPlacementRectangle.Left + HorizontalOffset, FPlacementRectangle.Top - Height -
              VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Left:
        {$ELSE}
        TPlacement.plLeft:
        {$ENDIF}
          begin
            LocalPos := PointF(FPlacementRectangle.Left - Width - HorizontalOffset,
              FPlacementRectangle.Top + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Right:
        {$ELSE}
        TPlacement.plRight:
        {$ENDIF}
          begin
            LocalPos := PointF(FPlacementRectangle.Right + HorizontalOffset, FPlacementRectangle.Top + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.BottomCenter:
        {$ELSE}
        TPlacement.plBottomCenter:
        {$ENDIF}
          begin
            LocalPos := PointF(FPlacementRectangle.Left + HorizontalOffset, FPlacementRectangle.Bottom + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.TopCenter:
        {$ELSE}
        TPlacement.plTopCenter:
        {$ENDIF}
          begin
            LocalPos := PointF(FPlacementRectangle.Left + HorizontalOffset, FPlacementRectangle.Top - Height -
              VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.LeftCenter:
        {$ELSE}
        TPlacement.plLeftCenter:
        {$ENDIF}
          begin
            LocalPos := PointF(FPlacementRectangle.Left - Width - HorizontalOffset,
              FPlacementRectangle.Top + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.RightCenter:
        {$ELSE}
        TPlacement.plRightCenter:
        {$ENDIF}
          begin
            LocalPos := PointF(FPlacementRectangle.Right + HorizontalOffset, FPlacementRectangle.Top + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Center:
        {$ELSE}
        TPlacement.plCenter:
        {$ENDIF}
          begin
            LocalPos := PointF(FPlacementRectangle.Left + (FPlacementRectangle.Right - FPlacementRectangle.Left - Width) /
              2, FPlacementRectangle.Top + (FPlacementRectangle.Bottom - FPlacementRectangle.Top - Height) / 2);
            LocalPos.X := LocalPos.X + HorizontalOffset;
            LocalPos.Y := LocalPos.Y + VerticalOffset;
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Absolute:
        {$ELSE}
        TPlacement.plAbsolute:
        {$ENDIF}
          begin
            {$IFDEF POPUPPANEL}
            FPopupForm.Position.X := FPlacementRectangle.Left;
            FPopupForm.Position.Y := FPlacementRectangle.Top;
            {$ELSE}
            FPopupForm.Left := Round(FPlacementRectangle.Left);
            FPopupForm.Top := Round(FPlacementRectangle.Top);
            {$ENDIF}
            Exit;
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Mouse:
        {$ELSE}
        TPlacement.plMouse:
        {$ENDIF}
          begin
            if Assigned(MouseService) then
            begin
              {$IFDEF POPUPPANEL}
              FPopupForm.Position.X := Pos.X;
              FPopupForm.Position.Y := Pos.Y;
              {$ELSE}
              FPopupForm.Left := Round(Pos.X);
              FPopupForm.Top := Round(Pos.Y);
              {$ENDIF}
            end;
            Exit;
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.MouseCenter:
        {$ELSE}
        TPlacement.plMouseCenter:
        {$ENDIF}
          begin
            if Assigned(MouseService) then
              Pos := MouseService.GetMousePos;

            {$IFDEF POPUPPANEL}
            FPopupForm.Position.X := Pos.X - Width / 2;
            FPopupForm.Position.Y := Pos.Y;
            {$ELSE}
            FPopupForm.Left := Round(Pos.X) - Round(Width / 2);
            FPopupForm.Top := Round(Pos.Y);
            {$ENDIF}
            Exit;
          end;
      end;
      if FScene <> nil then
        Pos := FScene.LocalToScreen(PointF(LocalPos.X, LocalPos.Y))
      else
        Pos := LocalPos;
    end
    else
    begin
      case Placement of
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Bottom:
        {$ELSE}
        TPlacement.plBottom:
        {$ENDIF}
          begin
            if FPlacementRectangle.Empty then
              LocalPos := PointF(HorizontalOffset, Target.Height + VerticalOffset)
            else
              LocalPos := PointF(FPlacementRectangle.Left + HorizontalOffset, FPlacementRectangle.Bottom + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Top:
        {$ELSE}
        TPlacement.plTop:
        {$ENDIF}
          begin
            if FPlacementRectangle.Empty then
              LocalPos := PointF(HorizontalOffset, -Height - VerticalOffset)
            else
              LocalPos := PointF(FPlacementRectangle.Left + HorizontalOffset, FPlacementRectangle.Top - Height -
                VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Left:
        {$ELSE}
        TPlacement.plLeft:
        {$ENDIF}
          begin
            if FPlacementRectangle.Empty then
              LocalPos := PointF(-Width - HorizontalOffset, VerticalOffset)
            else
              LocalPos := PointF(FPlacementRectangle.Left - Width - HorizontalOffset,
                FPlacementRectangle.Top + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Right:
        {$ELSE}
        TPlacement.plRight:
        {$ENDIF}
          begin
            if FPlacementRectangle.Empty then
              LocalPos := PointF(Target.Width + HorizontalOffset, VerticalOffset)
            else
              LocalPos := PointF(FPlacementRectangle.Right + HorizontalOffset, FPlacementRectangle.Top + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.BottomCenter:
        {$ELSE}
        TPlacement.plBottomCenter:
        {$ENDIF}
          begin
            if FPlacementRectangle.Empty then
              LocalPos := PointF(HorizontalOffset - (Width / 2) + (Target.Width / 2), Target.Height + VerticalOffset)
            else
              LocalPos := PointF((FPlacementRectangle.Left + FPlacementRectangle.Right) / 2 - (Width / 2) +
                HorizontalOffset, FPlacementRectangle.Bottom + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.TopCenter:
        {$ELSE}
        TPlacement.plTopCenter:
        {$ENDIF}
          begin
            if FPlacementRectangle.Empty then
              LocalPos := PointF(HorizontalOffset - (Width / 2) + (Target.Width / 2), -Height - VerticalOffset)
            else
              LocalPos := PointF((FPlacementRectangle.Left + FPlacementRectangle.Right) / 2 - (Width / 2) +
                HorizontalOffset, FPlacementRectangle.Top - Height - VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.LeftCenter:
        {$ELSE}
        TPlacement.plLeftCenter:
        {$ENDIF}
          begin
            if FPlacementRectangle.Empty then
              LocalPos := PointF(-Width - HorizontalOffset, VerticalOffset - (Height / 2) + (Target.Height / 2))
            else
              LocalPos := PointF(FPlacementRectangle.Left - Width - HorizontalOffset,
                FPlacementRectangle.Top + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.RightCenter:
        {$ELSE}
        TPlacement.plRightCenter:
        {$ENDIF}
          begin
            if FPlacementRectangle.Empty then
              LocalPos := PointF(Target.Width + HorizontalOffset, VerticalOffset - (Height / 2) + (Target.Height / 2))
            else
              LocalPos := PointF(FPlacementRectangle.Right + HorizontalOffset, FPlacementRectangle.Top + VerticalOffset);
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Center:
        {$ELSE}
        TPlacement.plCenter:
        {$ENDIF}
          begin
            if FPlacementRectangle.Empty then
              LocalPos := PointF((Target.Width - Width) / 2, (Target.Height - Height) / 2)
            else
              LocalPos := PointF(FPlacementRectangle.Left + (FPlacementRectangle.Right - FPlacementRectangle.Left - Width)
                / 2, FPlacementRectangle.Top + (FPlacementRectangle.Bottom - FPlacementRectangle.Top - Height) / 2);
            LocalPos.X := LocalPos.X + HorizontalOffset;
            LocalPos.Y := LocalPos.Y + VerticalOffset;
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Absolute:
        {$ELSE}
        TPlacement.plAbsolute:
        {$ENDIF}
          begin
            {$IFDEF POPUPPANEL}
            FPopupForm.Position.X := FPlacementRectangle.Left;
            FPopupForm.Position.Y := FPlacementRectangle.Top;
            {$ELSE}
            FPopupForm.Left := Round(FPlacementRectangle.Left);
            FPopupForm.Top := Round(FPlacementRectangle.Top);
            {$ENDIF}
            Exit;
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.Mouse:
        {$ELSE}
        TPlacement.plMouse:
        {$ENDIF}
          begin
            if Assigned(MouseService) then
              Pos := MouseService.GetMousePos;
            {$IFDEF POPUPPANEL}
            FPopupForm.Position.X := Pos.X;
            FPopupForm.Position.Y := Pos.Y;
            {$ELSE}
            FPopupForm.Left := Round(Pos.X);
            FPopupForm.Top := Round(Pos.Y);
            {$ENDIF}
            Exit;
          end;
        {$IFDEF DELPHIXE6_LVL}
        TPlacement.MouseCenter:
        {$ELSE}
        TPlacement.plMouseCenter:
        {$ENDIF}
          begin
            if Assigned(MouseService) then
              Pos := MouseService.GetMousePos;
            {$IFDEF POPUPPANEL}
            FPopupForm.Position.X := Pos.X - Width / 2;
            FPopupForm.Position.Y := Pos.Y;
            {$ELSE}
            FPopupForm.Left := Round(Pos.X) - Round(Width / 2);
            FPopupForm.Top := Round(Pos.Y);
            {$ENDIf}
            Exit;
          end;
      end;
      AbsolutePos := TProtectedControl(Target).LocalToScreen(LocalPos);
      Pos := PointF(AbsolutePos.X, AbsolutePos.Y);
    end;

    {$IFDEF POPUPPANEL}
    if not Transparent then
    begin
      FPopupForm.Position.X := Pos.X - EffectMargins.Left;
      FPopupForm.Position.Y := Pos.Y - EffectMargins.Top;
    end
    else
    begin
      FPopupForm.Position.X := Pos.X;
      FPopupForm.Position.Y := Pos.Y;
    end;
    {$IFNDEF ANDROID}
    FPopupForm.Position.Y := FPopupForm.Position.Y - 20;
    {$ENDIF}
    {$ELSE}
    if not Transparent then
    begin
      FPopupForm.Left := Round(Pos.X - EffectMargins.Left);
      FPopupForm.Top := Round(Pos.Y - EffectMargins.Top);
    end
    else
    begin
      FPopupForm.Left := Round(Pos.X);
      FPopupForm.Top := Round(Pos.Y);
    end;
    {$ENDIF}
  finally
  end;
end;

procedure TTMSFMXPopup.ApplyStyle;
begin
  inherited;
  AssignEvents;
  UpdatePopupShape;
  UpdateHeader;
  UpdateFooter;
  UpdateFooterPos;
  UpdateHeaderPos;
  UpdateShape;
  UpdateButtons;
  Transparent := Transparent;
end;

procedure TTMSFMXPopup.AssignEvents;
var
  ctlh, ctlf: TFmxObject;
begin
  ctlh := GetHeaderText;
  ctlf := GetFooterText;
  if Assigned(ctlh) and (ctlh is TTMSFMXHTMLText) then
    (ctlh as TTMSFMXHTMLText).OnAnchorClick := HeaderAnchorClick;

  if Assigned(ctlf) and (ctlf is TTMSFMXHTMLText) then
    (ctlf as TTMSFMXHTMLText).OnAnchorClick := FooterAnchorClick;
end;

procedure TTMSFMXPopup.CleanUpFooterButtons;
var
  str: TStringList;
  lName: String;
  footer: TFMXObject;
  i: integer;
  obj: TFMXObject;
  l: TTMSFMXBarButton;
begin
  footer := GetFooter;

  str := TStringList.Create;
  for i := 0 to FooterButtons.Count - 1 do
  begin
    lName := 'FMXPopupFooterButton'+inttostr(i);
    str.Add(UpperCase(lName+'Name'));
  end;

  if Assigned(footer) then
  begin
    for I := footer.ChildrenCount - 1 downto 0 do
    begin
      obj := footer.Children[i];
      if (obj is TTMSFMXBarButton) then
      begin
        l := obj as TTMSFMXBarButton;
        if (str.IndexOf(UpperCase(l.Name)) = -1) then
        begin
          {$IFDEF DELPHI_LLVM}
          l.Release;
          {$ELSE}
          l.Free;
          {$ENDIF}
        end;
      end;
    end;
  end;

  str.Free;
end;

procedure TTMSFMXPopup.CleanUpHeaderButtons;
var
  str: TStringList;
  lName: String;
  header: TFMXObject;
  i: integer;
  obj: TFMXObject;
  l: TTMSFMXBarButton;
begin
  header := GetHeader;

  str := TStringList.Create;
  for i := 0 to HeaderButtons.Count - 1 do
  begin
    lName := 'FMXPopupHeaderButton'+inttostr(i);
    str.Add(UpperCase(lName+'Name'));
  end;

  if Assigned(header) then
  begin
    for I := header.ChildrenCount - 1 downto 0 do
    begin
      obj := header.Children[i];
      if (obj is TTMSFMXBarButton) then
      begin
        l := obj as TTMSFMXBarButton;
        if (str.IndexOf(UpperCase(l.Name)) = -1) then
        begin
          {$IFDEF DELPHI_LLVM}
          l.Release;
          {$ELSE}
          l.Free;
          {$ENDIF}
        end;
      end;
    end;
  end;

  str.Free;
end;

procedure TTMSFMXPopup.ClosePopup;
begin
  if Assigned(FPopupForm) then
  begin
    {$IFDEF POPUPPANEL}
    DoClose;
    {$ELSE}
    FPopupForm.Close;
    {$ENDIF}
  end;
end;

procedure TTMSFMXPopup.DoClose;
var
  ctl: TFmxObject;
  {$IFDEF POPUPPANEL}
  frm: TCommonCustomForm;
  {$ENDIF}
begin
  if FDestroying then
    Exit;

  if FPopupForm = nil then
    Exit;

  FreeAndNil(FDragTimer);

  FDestroying := True;

  ctl := FindStyleResource('popupcontainer');
  if Assigned(ctl) and Assigned(DetailControl) and not (csDestroying in ComponentState) then
  begin
    ctl.removeobject(DetailControl);
    DetailControl.Parent :=  FSaveParentDetail;
    if Assigned(DetailControl.Parent) then
      DetailControl.Visible := False;
    if Assigned(DetailControl.Parent) then
      DetailControl.SetFocus;
  end;

  if (FPopupForm = nil) then
    Exit;

  { hide }
  Visible := False;
  { remove self }
  FPopupForm.RemoveObject(Self);
  {$IFNDEF IOS}
  TForm(FPopupForm).StyleBook := nil;
  {$ENDIF}
  SetNewScene(nil);
  { free }
  FPopupForm.RemoveObject(Self);
  if not (csDestroying in ComponentState) then
    Parent := FSaveParent;

  FSaveParent := nil;
  {$IFDEF POPUPPANEL}
  FPopupForm.Release;
  {$ELSE}
  TForm(FPopupForm).Release;
  {$ENDIF}
  FPopupForm := nil;

  {$IFDEF POPUPPANEL}
  frm := GetParentForm;
  if Assigned(frm) and Assigned(Flt) then
  begin
    frm.RemoveObject(flt);
    Flt.Free;
  end;
  {$ENDIF}

  if Assigned(FOnClosePopup) then
    FOnClosePopup(Self);

  FDestroying := False;
end;

function TTMSFMXPopup.DoesFooterButtonExist(AButtonName: String): TTMSFMXBarButton;
var
  footer: TFMXObject;
  i: integer;
  obj: TFMXObject;
  l: TTMSFMXBarButton;
begin
  Result := nil;

  footer := GetFooter;

  if Assigned(footer) then
  begin
    for I := 0 to footer.ChildrenCount - 1 do
    begin
      obj := footer.Children[i];
      if (obj is TTMSFMXBarButton) then
      begin
        l := obj as TTMSFMXBarButton;
        if UpperCase(l.StyleName) = UpperCase(AButtonName) then
        begin
          Result := l;
          Break;
        end;
      end;
    end;
  end;
end;

function TTMSFMXPopup.DoesHeaderButtonExist(AButtonName: String): TTMSFMXBarButton;
var
  header: TFMXObject;
  i: integer;
  obj: TFMXObject;
  l: TTMSFMXBarButton;
begin
  Result := nil;

  header := GetHeader;

  if Assigned(header) then
  begin
    for I := 0 to header.ChildrenCount - 1 do
    begin
      obj := header.Children[i];
      if (obj is TTMSFMXBarButton) then
      begin
        l := obj as TTMSFMXBarButton;
        if UpperCase(l.StyleName) = UpperCase(AButtonName) then
        begin
          Result := l;
          Break;
        end;
      end;
    end;
  end;
end;

constructor TTMSFMXPopup.Create(AOwner: TComponent);
begin
  inherited;
  FShadow := True;
  FTransparent := False;
  FPlacementRectangle := TBounds.Create(RectF(0, 0, 0, 0));
  FEffectMargins := TBounds.Create(RectF(10, 10, 10, 10));
  FArrowPosition := paTopCenter;
  FShowHeader := True;
  FShowFooter := True;
  FDragWithParent := True;
  FControlMargins := TBounds.Create(RectF(0, 0, 0, 0));

  FHeaderButtons := TTMSFMXPopupButtons.Create(Self);
  FFooterButtons := TTMSFMXPopupButtons.Create(Self);


  if (csDesigning in ComponentState) and not
    ((csReading in Owner.ComponentState) or (csLoading in Owner.ComponentState)) then
  begin
    FArrowHeight := 11;
    FArrowWidth := 23;
    FHeaderHeight := 24;
    FFooterHeight := 24;
    FHeaderText := 'Header';
    FFooterText := 'Footer';
    Visible := False;
  end;

  Width := 190;
  Height := 250;
end;

destructor TTMSFMXPopup.Destroy;
begin
  DoClose;
  FFooterButtons.Free;
  FHeaderButtons.Free;
  FControlMargins.Free;
  FPlacementRectangle.Free;
  FEffectMargins.Free;
  inherited;
end;

procedure TTMSFMXPopup.DialogKey(var Key: Word; Shift: TShiftState);
begin
  inherited DialogKey(Key, Shift);
  if (Key = vkEscape) and not StaysOpen then
  begin
    DoClose;
    Key := 0;
  end;
end;

procedure TTMSFMXPopup.DoFormClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  if (not StaysOpen) then
    DoClose;
end;

procedure TTMSFMXPopup.DoMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if (not StaysOpen) then
    DoClose;
end;

procedure TTMSFMXPopup.DoTimer(Sender: TObject);
begin
  {$IFDEF DELPHIXE6_LVL}
  if not (Placement in [TPlacement.Mouse, TPlacement.MouseCenter]) then
  {$ELSE}
  if not (Placement in [TPlacement.plMouse, TPlacement.plMouseCenter]) then
  {$ENDIF}
    ApplyPlacement;
end;

procedure TTMSFMXPopup.FooterAnchorClick(Sender: TObject; AAnchor: String);
begin
  if Assigned(OnFooterAnchorClick) then
    OnFooterAnchorClick(Sender, AAnchor);
end;

procedure TTMSFMXPopup.FooterButtonClick(Sender: TObject);
var
  shp: TTMSFMXBarButton;
  AButton: TTMSFMXPopupButton;
begin
  if Assigned(OnFooterButtonClick) then
  begin
    if Assigned(Sender) and (Sender is TTMSFMXBarButton) then
    begin
      shp := (Sender as TTMSFMXBarButton);
      AButton := nil;
      if (shp.Tag >= 0) and (shp.Tag <= FooterButtons.Count - 1) then
        AButton := FooterButtons[shp.Tag];

      OnFooterButtonClick(Sender, AButton, shp);
    end;
  end;
end;

function TTMSFMXPopup.GetButton: TTMSFMXBarButton;
var
  ctl: TFmxObject;
begin
  Result := nil;
  ctl := FindStyleResource('popupcontainerbutton');
  if ctl is TTMSFMXBarButton then
    Result := ctl as TTMSFMXBarButton;
end;

function TTMSFMXPopup.GetFooter: TFMXObject;
begin
  Result := FindStyleResource('popupcontainerfooter')
end;

function TTMSFMXPopup.GetFooterText: TFMXObject;
begin
  Result := FindStyleResource('popupcontainerfootertext')
end;

function TTMSFMXPopup.GetHeader: TFMXObject;
begin
  Result := FindStyleResource('popupcontainerheader')
end;

function TTMSFMXPopup.GetHeaderText: TFMXObject;
begin
  Result := FindStyleResource('popupcontainerheadertext')
end;

function TTMSFMXPopup.GetInstance: NativeUInt;
begin
  Result := HInstance;
end;

function TTMSFMXPopup.GetIsOpen: Boolean;
begin
  Result := Assigned(FPopupForm);
end;

function TTMSFMXPopup.GetParentForm(AControl: TFMXObject = nil): TCommonCustomForm;
var
  c: TFMXObject;
begin
  Result := nil;
  if Assigned(AControl) then
    c := AControl
  else
  begin
    if Assigned(ParentControl) then
      c := ParentControl
    else
      c := Self;
  end;

  if not Assigned(c) then
    Exit;

  if c.Parent is TCommonCustomForm then
    Result := c.Parent as TCommonCustomForm
  else
    Result := GetParentForm(c.Parent);
end;

function TTMSFMXPopup.GetPopup: TFMXObject;
begin
  Result := FindStyleResource('popupcontainer');
end;

function TTMSFMXPopup.GetVersion: string;
var
  vn: Integer;
begin
  vn := GetVersionNr;
  Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn)));
end;

function TTMSFMXPopup.GetVersionNr: integer;
begin
  Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;

procedure TTMSFMXPopup.HeaderAnchorClick(Sender: TObject; AAnchor: String);
begin
  if Assigned(OnHeaderAnchorClick) then
    OnHeaderAnchorClick(Sender, AAnchor);
end;

procedure TTMSFMXPopup.HeaderButtonClick(Sender: TObject);
var
  shp: TTMSFMXBarButton;
  AButton: TTMSFMXPopupButton;
begin
  if Assigned(OnHeaderButtonClick) then
  begin
    if Assigned(Sender) and (Sender is TTMSFMXBarButton) then
    begin
      shp := (Sender as TTMSFMXBarButton);
      AButton := nil;
      if (shp.Tag >= 0) and (shp.Tag <= HeaderButtons.Count - 1) then
        AButton := HeaderButtons[shp.Tag];

      OnHeaderButtonClick(Sender, AButton, shp);
    end;
  end;
end;

procedure TTMSFMXPopup.HidePopup;
begin
  ClosePopup;
end;

function TTMSFMXPopup.IsDetailControlAdded(AControl: TFMXObject): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to AControl.ChildrenCount - 1 do
  begin
    if AControl.Children[I] = DetailControl then
    begin
      Result := True;
      Break;
    end;
  end;
end;

procedure TTMSFMXPopup.Loaded;
begin
  inherited;
  if not (csDesigning in ComponentState) then
    Visible := False;
end;

procedure TTMSFMXPopup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (AComponent = FPlacementTarget) and (Operation = opRemove) then
    FPlacementTarget := nil;
  if (AComponent = FSaveParent) and (Operation = opRemove) then
    FSaveParent := nil;
  if (AComponent = FSaveParentDetail) and (Operation = opRemove) then
    FSaveParentDetail := nil;
  if (AComponent = FBitmapContainer) and (Operation = opRemove) then
    FBitmapContainer := nil;
end;

procedure TTMSFMXPopup.SetArrowHeight(const Value: Single);
begin
  if FArrowHeight <> Value then
  begin
    FArrowHeight := Value;
    UpdateHeaderPos;
    UpdateFooterPos;
    UpdatePopupShape;
  end;
end;

procedure TTMSFMXPopup.SetArrowPosition(
  const Value: TTMSFMXPopupShapeArrowPosition);
begin
  if FArrowPosition <> Value then
  begin
    FArrowPosition := Value;
    UpdateHeaderPos;
    UpdateFooterPos;
    UpdatePopupShape;
  end;
end;

procedure TTMSFMXPopup.SetArrowWidth(const Value: Single);
begin
  if FArrowWidth <> Value then
  begin
    FArrowWidth := Value;
    UpdatePopupShape;
  end;
end;

procedure TTMSFMXPopup.SetDetailControl(const Value: TControl);
begin
  FDetailControl := Value;
  if Assigned(FDetailControl) then
    FDetailControl.Visible := False;
end;

procedure TTMSFMXPopup.SetEffectMargins(const Value: TBounds);
begin
  if FEffectMargins <> Value then
    FEffectMargins := Value;
end;

procedure TTMSFMXPopup.SetFooterButtons(const Value: TTMSFMXPopupButtons);
begin
  if FFooterButtons <> Value then
  begin
    FFooterButtons.Assign(Value);
    UpdateButtons;
  end;
end;

procedure TTMSFMXPopup.SetFooterHeight(const Value: Single);
begin
  if FFooterHeight <> Value then
  begin
    FFooterHeight := Value;
    UpdateFooter;
    UpdateFooterPos;
    UpdateShape;
  end;
end;

procedure TTMSFMXPopup.SetFooterText(const Value: String);
begin
  if FFooterText <> Value then
  begin
    FFooterText := Value;
    UpdateFooter;
  end;
end;

procedure TTMSFMXPopup.SetHeaderButtons(const Value: TTMSFMXPopupButtons);
begin
  if FHeaderButtons <> Value then
  begin
    FHeaderButtons := Value;
    UpdateButtons;
  end;
end;

procedure TTMSFMXPopup.SetHeaderHeight(const Value: Single);
begin
  if FHeaderHeight <> Value then
  begin
    FHeaderHeight := Value;
    UpdateHeader;
    UpdateHeaderPos;
    UpdateShape;
  end;
end;

procedure TTMSFMXPopup.SetHeaderText(const Value: String);
begin
  if FHeaderText <> Value then
  begin
    FHeaderText := Value;
    UpdateHeader;
  end;
end;

procedure TTMSFMXPopup.SetIsOpen(const Value: Boolean);
begin
  if Value then
    Popup
  else
    DoClose;
end;

procedure TTMSFMXPopup.SetPlacementRectangle(const Value: TBounds);
begin
  if FPlacementRectangle <> value then
    FPlacementRectangle.Assign(Value);
end;

procedure TTMSFMXPopup.SetShadow(const Value: Boolean);
begin
  FShadow := Value;
  UpdateShadow;
end;

procedure TTMSFMXPopup.SetShowFooter(const Value: Boolean);
begin
  if FShowFooter <> Value then
  begin
    FShowFooter := Value;
    UpdateFooter;
    UpdateShape;
  end;
end;

procedure TTMSFMXPopup.SetShowHeader(const Value: Boolean);
begin
  if FShowHeader <> Value then
  begin
    FShowHeader := Value;
    UpdateHeader;
    UpdateShape;
  end;
end;

procedure TTMSFMXPopup.SetTransparent(const Value: Boolean);
var
  obj: TFmxObject;
begin
  FTransparent := Value;
  obj := FindStyleResource('popupcontainer');
  if Assigned(obj) and (obj is TTMSFMXPopupShape) then
    (obj as TTMSFMXPopupShape).Visible := not Value;
end;

procedure TTMSFMXPopup.SetVersion(const Value: String);
begin

end;

{$IFDEF DELPHIXE6_LVL}
procedure TTMSFMXPopup.ShowPopup(AControl: TControl = nil; APlacement: TPlacement = TPlacement.Bottom);
{$ELSE}
procedure TTMSFMXPopup.ShowPopup(AControl: TControl = nil; APlacement: TPlacement = TPlacement.plBottom);
{$ENDIF}
begin
  PlacementTarget := AControl;
  Placement := APlacement;
  Popup;
end;

procedure TTMSFMXPopup.UpdateButtons;
var
  I: Integer;
  sn: String;
  newb, b: TTMSFMXBarButton;
  origb: TTMSFMXBarButton;
  header, footer: TFMXObject;
begin
  if csDestroying in ComponentState then
    Exit;

  BeginUpdate;
  header := GetHeader;
  footer := GetFooter;
  origb := GetButton;

  if Assigned(header) and Assigned(origb) and Assigned(footer) and (origb is TTMSFMXBarButton) then
  begin
    for I := 0 to HeaderButtons.Count - 1 do
    begin
      sn := 'FMXPopupHeaderButton'+inttostr(I);
      b := DoesHeaderButtonExist(sn);
      if Assigned(b) then
        newb := b
      else
      begin
        newb := origb.Clone(header) as TTMSFMXBarButton;
        CloneChildrenBase(origb, newb);
        newb.BeginUpdate;
        newb.Visible := True;
        newb.Name := sn + 'Name';
        newb.StyleName := sn;
        header.AddObject(newb);
        newb.ApplyStyleLookup;
        newb.OnClick := HeaderButtonClick;
        newb.EndUpdate;
      end;

      newb.Tag := I;
      newb.Width := HeaderButtons[I].Width;
      newb.Text := HeaderButtons[I].Text;
      newb.ShowImage := HeaderButtons[I].ShowImage;
      newb.ShowText := HeaderButtons[I].ShowText;
      newb.BitmapName := HeaderButtons[I].BitmapName;
      newb.Kind := HeaderButtons[I].Kind;
      newb.BitmapContainer := BitmapContainer;

      HeaderButtons[I].PopupButton := newb;
      if Assigned(OnCustomizeHeaderButton) then
        OnCustomizeHeaderButton(self, HeaderButtons[I], newb);
    end;

    for I := 0 to FooterButtons.Count - 1 do
    begin
      sn := 'FMXPopupFooterButton'+inttostr(I);
      b := DoesFooterButtonExist(sn);
      if Assigned(b) then
        newb := b
      else
      begin
        newb := origb.Clone(footer) as TTMSFMXBarButton;
        CloneChildrenBase(origb, newb);
        newb.BeginUpdate;
        newb.Visible := True;
        newb.Name := sn + 'Name';
        newb.StyleName := sn;
        footer.AddObject(newb);
        newb.ApplyStyleLookup;
        newb.OnClick := FooterButtonClick;
        newb.EndUpdate;
      end;

      newb.Tag := I;
      newb.Width := FooterButtons[I].Width;
      newb.Text := FooterButtons[I].Text;
      newb.ShowImage := FooterButtons[I].ShowImage;
      newb.ShowText := FooterButtons[I].ShowText;
      newb.BitmapName := FooterButtons[I].BitmapName;
      newb.Kind := FooterButtons[I].Kind;
      newb.BitmapContainer := BitmapContainer;

      FooterButtons[I].PopupButton := newb;
      if Assigned(OnCustomizeFooterButton) then
        OnCustomizeFooterButton(self, FooterButtons[I], newb);
    end;
  end;

  CleanUpHeaderButtons;
  CleanUpFooterButtons;
  EndUpdate;
end;

procedure TTMSFMXPopup.UpdateFooter;
var
  ctl: TControl;
begin
  ctl := GetFooter as TControl;
  if Assigned(ctl) then
  begin
    ctl.Height := FooterHeight;
    ctl.Visible := ShowFooter;
  end;

  ctl := GetFooterText as TControl;
  if Assigned(ctl) then
    (ctl as TText).Text := FooterText;
end;

procedure TTMSFMXPopup.UpdateFooterPos;
var
  ctl, ctlh: TControl;
  m: TBounds;
begin
  ctlh := GetFooter as TControl;
  ctl := GetPopup as TControl;
  if Assigned(ctl) and assigned(ctlh) then
  begin
    m := ctl.Padding;
    case ArrowPosition of
      paLeftBottom, paLeftCenter, paLeftTop:
      begin
        ctlh.Position.Y := Height - ctlh.Height - m.Top / 2;
        ctlh.Position.X := ArrowHeight + m.Left;
        ctlh.Width := Width - m.Left - m.Right - ArrowHeight;
      end;
      paTopRight, paTopCenter, paTopLeft:
      begin
        ctlh.Position.Y := Height - ctlh.Height - m.Top / 2;
        ctlh.Position.X := m.Left;
        ctlh.Width := Width - m.Left - m.Right;
      end;
      paRightTop, paRightCenter, paRightBottom:
      begin
        ctlh.Position.Y := Height - ctlh.Height - m.Top / 2;
        ctlh.Position.X := m.Left;
        ctlh.Width := Width - m.Left - m.Right - ArrowHeight;
      end;
      paBottomLeft, paBottomCenter, paBottomRight:
      begin
        ctlh.Position.Y := Height - ctlh.Height - ArrowHeight - m.Top / 2;
        ctlh.Position.X := m.Left;
        ctlh.Width := Width - m.Left - m.Right;
      end;
    end;
  end;
end;

procedure TTMSFMXPopup.UpdateHeader;
var
  ctl: TControl;
begin
  ctl := GetHeader as TControl;
  if Assigned(ctl) then
  begin
    ctl.Height := HeaderHeight;
    ctl.Visible := ShowHeader;
  end;

  ctl := GetHeaderText as TControl;
  if Assigned(ctl) then
    (ctl as TText).Text := HeaderText;
end;

procedure TTMSFMXPopup.UpdateHeaderPos;
var
  ctl, ctlh: TControl;
  m: TBounds;
begin
  ctlh := GetHeader as TControl;
  ctl := GetPopup as TControl;
  if Assigned(ctl) and assigned(ctlh) then
  begin
    m := ctl.Padding;
    case ArrowPosition of
      paLeftBottom, paLeftCenter, paLeftTop:
      begin
        ctlh.Position.Y := m.Top / 2;
        ctlh.Position.X := ArrowHeight + m.Left;
        ctlh.Width := Width - m.Left - m.Right - ArrowHeight;
      end;
      paTopRight, paTopCenter, paTopLeft:
      begin
        ctlh.Position.Y := m.Top / 2 + ArrowHeight;
        ctlh.Position.X := m.Left;
        ctlh.Width := Width - m.Left - m.Right;
      end;
      paRightTop, paRightCenter, paRightBottom:
      begin
        ctlh.Position.Y := m.Top / 2;
        ctlh.Position.X := m.Left;
        ctlh.Width := Width - m.Left - m.Right - ArrowHeight;
      end;
      paBottomLeft, paBottomCenter, paBottomRight:
      begin
        ctlh.Position.Y := m.Top / 2;
        ctlh.Position.X := m.Left;
        ctlh.Width := Width - m.Left - m.Right;
      end;
    end;
  end;
end;

procedure TTMSFMXPopup.UpdatePopupShape;
var
  ctl: TControl;
begin
  ctl := GetPopup as TControl;
  if Assigned(ctl) and (ctl is TTMSFMXPopupShape) then
  begin
    (ctl as TTMSFMXPopupShape).ArrowHeight := ArrowHeight;
    (ctl as TTMSFMXPopupShape).ArrowWidth := ArrowWidth;
    (ctl as TTMSFMXPopupShape).ArrowPosition := ArrowPosition;
  end;
end;

procedure TTMSFMXPopup.UpdateShadow;
var
  obj: TFmxObject;
begin
  obj := FindStyleResource('popupshadoweffect');
  if Assigned(obj) and (obj is TEffect) then
    (obj as TEffect).Enabled := Shadow;
end;

procedure TTMSFMXPopup.UpdateShape;
var
  ctl, cth, ctf: TControl;
  h: Single;
begin
  if csDesigning in ComponentState then
    Exit;

  ctl := GetPopup as TControl;
  if Assigned(ctl) and (ctl is TTMSFMXPopupShape) then
  begin
    FControlMargins.Assign(ctl.Padding);
    h := (ctl as TTMSFMXPopupShape).ArrowHeight;
    case (ctl as TTMSFMXPopupShape).ArrowPosition of
      paLeftTop, paLeftCenter, paLeftBottom: FControlMargins.Left := FControlMargins.Left + h;
      paTopLeft, paTopCenter, paTopRight: FControlMargins.Top := FControlMargins.Top + h;
      paRightTop, paRightCenter, paRightBottom: FControlMargins.Right := FControlMargins.Right + h;
      paBottomLeft, paBottomCenter, paBottomRight: FControlMargins.Bottom := FControlMargins.Bottom + h;
    end;

    if ShowHeader then
    begin
      cth := GetHeader as TControl;
      if Assigned(cth) then
        FControlMargins.Top := FControlMargins.Top + cth.Height;
    end;

    if ShowFooter then
    begin
      ctf := GetFooter as TControl;
      if Assigned(ctf) then
        FControlMargins.Bottom := FControlMargins.Bottom + ctf.Height;
    end;

    ctl.Padding.Assign(FControlMargins);
  end;
end;

procedure TTMSFMXPopup.Popup;
var
  ctl: TFMXObject;
  {$IFDEF POPUPPANEL}
  frm: TCommonCustomForm;
  {$ENDIF}
begin
  if FCreating or Assigned(FPopupForm) then
    Exit;

  {$IFDEF POPUPPANEL}
  frm := GetParentForm;
  if Assigned(frm) then
  begin
    Flt := TLayout.Create(frm);
    {$IFDEF DELPHIXE6_LVL}
    Flt.Align := TAlignLayout.Client;
    {$ELSE}
    Flt.Align := TAlignLayout.alClient;
    {$ENDIF}
    Flt.Parent := frm;
    flt.HitTest := True;
    Flt.OnMouseDown := DoMouseDown;
  end;
  {$ENDIF}


  FCreating := True;
  {$IFDEF POPUPPANEL}
  FPopupForm := TControl.Create(nil);
  {$ELSE}
  FPopupForm := TCustomForm.CreateNew(Self);
  {$ENDIF}
  Randomize;
  FPopupForm.Name := 'PopupForm'+inttostr(Random(1000000));
//  FPopupForm.BeginUpdate;
  try
    {$IFNDEF POPUPPANEL}
      {$IFNDEF DELPHIXE5_LVL}
      FPopupForm.TopMost := True;
      FPopupForm.ShowActivated := ShowActivated;
      FPopupForm.StaysOpen := StaysOpen;
      {$ELSE}
      if not ShowActivated or not StaysOpen then
        {$IFDEF DELPHIXE6_LVL}
        FPopupForm.FormStyle := TFormStyle.Popup;
        {$ELSE}
        FPopupForm.FormStyle := TFormStyle.fsPopup;
        {$ENDIF}
      {$ENDIF}
      FPopupForm.OnClose := DoFormClose;
      {$IFDEF DELPHIXE6_LVL}
      FPopupForm.BorderStyle := TFmxFormBorderStyle.None;
      FPopupForm.Fill.Kind := TBrushKind.None;
      {$ELSE}
      FPopupForm.BorderStyle := TFmxFormBorderStyle.bsNone;
      FPopupForm.Fill.Kind := TBrushKind.bkNone;
      {$ENDIF}
      FPopupForm.Transparency := True;
    {$ENDIF}

    {$IFDEF DELPHIXE5_LVL}
    {$IFNDEF POPUPPANEL}
    FPopupForm.Show;
    {$ENDIF}
    {$ENDIF}

    if not Transparent then
    begin
      FPopupForm.Width := Round(Width + EffectMargins.Right + EffectMargins.Left);
      FPopupForm.Height := Round(Height + EffectMargins.Bottom + EffectMargins.Top);
      FPopupForm.Padding.Left := EffectMargins.Left;
      FPopupForm.Padding.Top := EffectMargins.Top;
      FPopupForm.Padding.Right := EffectMargins.Right;
      FPopupForm.Padding.Bottom := EffectMargins.Bottom;
    end
    else
    begin
      FPopupForm.Width := Round(Width);
      FPopupForm.Height := Round(Height);
    end;

    FSaveParent := Parent;
    FPopupForm.AddObject(Self);
    {$IFDEF DELPHIXE6_LVL}
    Align := TAlignLayout.Client;
    {$ELSE}
    Align := TAlignLayout.alClient;
    {$ENDIF}
    Visible := True;
    NeedStyleLookup;
    ApplyStyleLookup;
    if Assigned(DetailControl) then
    begin
      if not Transparent then
        ctl := GetPopup
      else
        ctl := FPopupForm;

      if Assigned(ctl) and not IsDetailControlAdded(ctl) then
      begin
        FSaveParentDetail := DetailControl.Parent;
        ctl.AddObject(DetailControl);
        {$IFDEF DELPHIXE6_LVL}
        DetailControl.Align := TAlignLayout.Client;
        {$ELSE}
        DetailControl.Align := TAlignLayout.alClient;
        {$ENDIF}
        DetailControl.Visible := True;
//        DetailControl.SetFocus;
      end;
    end;
  finally
//    FPopupForm.EndUpdate;
  end;

  if Assigned(FPopupForm) then
  begin
    ApplyPlacement;
    ApplyAutoPosition;
    {$IFDEF POPUPPANEL}
    if Assigned(frm) then
    begin
      FPopupForm.Parent := frm;
      FPopupForm.Visible := True;
    end;
    {$ELSE}
    {$IFNDEF DELPHIXE5_LVL}
    if StaysOpen and ShowActivated then
      FPopupForm.ShowModal
    else
    {$ENDIF}
      FPopupForm.Show;
    {$ENDIF}

    if FDragWithParent then
    begin
      FDragTimer := TTimer.Create(Self);
      FDragTimer.Interval := 10;
      FDragTimer.OnTimer := DoTimer;
      FDragTimer.Enabled := True;
    end;
  end;

  FCreating := False;
end;

procedure TTMSFMXPopup.Resize;
begin
  inherited;
  ApplyStyle;
  if Assigned(FPopupForm) then
  begin
    FPopupForm.Width := Round(Width);
    FPopupForm.Height := Round(Height);
  end;
end;

{ TTMSFMXPopupShape }

constructor TTMSFMXPopupShape.Create(AOwner: TComponent);
begin
  inherited;
  FArrowPosition := paTopCenter;
  FArrowHeight := 11;
  FArrowWidth := 23;
end;

function TTMSFMXPopupShape.GetPath: TPathData;
var
  x1, x2, y1, y2: Single;
  R: TRectF;
  Off: Single;
  szoff: Single;
  szh, szw: Single;
  cth, ctf: TControl;
begin
  Result := TPathData.Create;
  R := ShapeRect;
  szh := ArrowHeight;
  szw := ArrowWidth;
  szoff := 0;

  case ArrowPosition of
    paRightBottom, paRightCenter, paRightTop: R.Width := R.Width - szh;
    paLeftTop, paLeftCenter, paLeftBottom:R.Left := R.Left + szh;
    paTopLeft, paTopCenter, paTopRight:R.Top := R.Top + szh;
    paBottomLeft, paBottomCenter, paBottomRight: R.Height :=  R.Height - szh;
  end;

  if Sides <> AllSides then
  begin
    Off := R.Left;
    {$IFDEF DELPHIXE6_LVL}
    if not(TSide.Top in Sides) then
      R.Top := R.Top - Off;
    if not(TSide.Left in Sides) then
      R.Left := R.Left - Off;
    if not(TSide.Bottom in Sides) then
      R.Bottom := R.Bottom + Off;
    if not(TSide.Right in Sides) then
      R.Right := R.Right + Off;
    {$ELSE}
    if not(TSide.sdTop in Sides) then
      R.Top := R.Top - Off;
    if not(TSide.sdLeft in Sides) then
      R.Left := R.Left - Off;
    if not(TSide.sdBottom in Sides) then
      R.Bottom := R.Bottom + Off;
    if not(TSide.sdRight in Sides) then
      R.Right := R.Right + Off;
    {$ENDIF}
  end;
  x1 := XRadius;
  if (RectWidth(R) - (x1 * 2) < 0) and (x1 > 0) then
    x1 := (XRadius * (RectWidth(R) / (x1 * 2)));
  x2 := x1 / 2;
  y1 := YRadius;
  if (RectHeight(R) - (y1 * 2) < 0) and (y1 > 0) then
    y1 := (YRadius * (RectHeight(R) / (y1 * 2)));
  y2 := y1 / 2;
  Result.Clear;
  Result.MoveTo(PointF(R.Left, R.Top + y1));

  {$IFDEF DELPHIXE6_LVL}
  if TCorner.TopLeft in Corners then
  begin
    case CornerType of
      // ctRound - default
      TCornerType.Bevel:
        Result.LineTo(PointF(R.Left + x1, R.Top));
      TCornerType.InnerRound:
        Result.CurveTo(PointF(R.Left + x2, R.Top + y1),
          PointF(R.Left + x1, R.Top + y2), PointF(R.Left + x1, R.Top));
      TCornerType.InnerLine:
        begin
          Result.LineTo(PointF(R.Left + x2, R.Top + y1));
          Result.LineTo(PointF(R.Left + x1, R.Top + y2));
          Result.LineTo(PointF(R.Left + x1, R.Top));
        end;
  {$ELSE}
  if TCorner.crTopLeft in Corners then
  begin
    case CornerType of
      // ctRound - default
      TCornerType.ctBevel:
        Result.LineTo(PointF(R.Left + x1, R.Top));
      TCornerType.ctInnerRound:
        Result.CurveTo(PointF(R.Left + x2, R.Top + y1),
          PointF(R.Left + x1, R.Top + y2), PointF(R.Left + x1, R.Top));
      TCornerType.ctInnerLine:
        begin
          Result.LineTo(PointF(R.Left + x2, R.Top + y1));
          Result.LineTo(PointF(R.Left + x1, R.Top + y2));
          Result.LineTo(PointF(R.Left + x1, R.Top));
        end;
  {$ENDIF}
    else
      Result.CurveTo(PointF(R.Left, R.Top + (y2)), PointF(R.Left + x2, R.Top),
        PointF(R.Left + x1, R.Top))
    end;
  end
  else
  begin
    {$IFDEF DELPHIXE6_LVL}
    if TSide.Left in Sides then
      Result.LineTo(R.TopLeft)
    else
      Result.MoveTo(R.TopLeft);
    if TSide.Top in Sides then
      Result.LineTo(PointF(R.Left + x1, R.Top))
    else
      Result.MoveTo(PointF(R.Left + x1, R.Top));
    {$ELSE}
    if TSide.sdLeft in Sides then
      Result.LineTo(R.TopLeft)
    else
      Result.MoveTo(R.TopLeft);
    if TSide.sdTop in Sides then
      Result.LineTo(PointF(R.Left + x1, R.Top))
    else
      Result.MoveTo(PointF(R.Left + x1, R.Top));
    {$ENDIF}
  end;
  {$IFDEF DELPHIXE6_LVL}
  if not(TSide.Top in Sides) then
  {$ELSE}
  if not(TSide.sdTop in Sides) then
  {$ENDIf}
    Result.MoveTo(PointF(R.Right - x1, R.Top))
  else
  begin
    if (ArrowPosition = paTopCenter) then
    begin
      Result.LineTo(PointF((R.Right - R.Left) / 2 - (szw / 2), R.Top));
      Result.LineTo(PointF((R.Right - R.Left) / 2, R.Top - szh));
      Result.LineTo(PointF((R.Right - R.Left) / 2 + (szw / 2), R.Top));
      Result.LineTo(PointF(R.Right - x1, R.Top));
    end
    else if (ArrowPosition = paTopLeft) then
    begin
      Result.LineTo(PointF(R.Left + szoff + XRadius, R.Top));
      Result.LineTo(PointF(R.Left + szoff + XRadius + (szw / 2), R.Top - szh));
      Result.LineTo(PointF(R.Left + szoff + XRadius + szw, R.Top));
      Result.LineTo(PointF(R.Right - x1, R.Top));
    end
    else if (ArrowPosition = paTopRight) then
    begin
      Result.LineTo(PointF(R.Right - szoff - XRadius - szw, R.Top));
      Result.LineTo(PointF(R.Right - szoff - XRadius - (szw / 2), R.Top - szh));
      Result.LineTo(PointF(R.Right - szoff - XRadius, R.Top));
      Result.LineTo(PointF(R.Right - x1, R.Top));
    end
    else
      Result.LineTo(PointF(R.Right - x1, R.Top));
  end;
  {$IFDEF DELPHIXE6_LVL}
  if TCorner.TopRight in Corners then
  begin
    case CornerType of
      // ctRound - default
      TCornerType.Bevel:
        Result.LineTo(PointF(R.Right, R.Top + y1));
      TCornerType.InnerRound:
        Result.CurveTo(PointF(R.Right - x1, R.Top + y2),
          PointF(R.Right - x2, R.Top + y1), PointF(R.Right, R.Top + y1));
      TCornerType.InnerLine:
        begin
          Result.LineTo(PointF(R.Right - x1, R.Top + y2));
          Result.LineTo(PointF(R.Right - x2, R.Top + y1));
          Result.LineTo(PointF(R.Right, R.Top + y1));
        end;
  {$ELSE}
  if TCorner.crTopRight in Corners then
  begin
    case CornerType of
      // ctRound - default
      TCornerType.ctBevel:
        Result.LineTo(PointF(R.Right, R.Top + y1));
      TCornerType.ctInnerRound:
        Result.CurveTo(PointF(R.Right - x1, R.Top + y2),
          PointF(R.Right - x2, R.Top + y1), PointF(R.Right, R.Top + y1));
      TCornerType.ctInnerLine:
        begin
          Result.LineTo(PointF(R.Right - x1, R.Top + y2));
          Result.LineTo(PointF(R.Right - x2, R.Top + y1));
          Result.LineTo(PointF(R.Right, R.Top + y1));
        end;
  {$ENDIF}
    else
      Result.CurveTo(PointF(R.Right - x2, R.Top), PointF(R.Right, R.Top + (y2)),
        PointF(R.Right, R.Top + y1))
    end;

  end
  else
  begin
    {$IFDEF DELPHIXE6_LVL}
    if TSide.Top in Sides then
      Result.LineTo(PointF(R.Right, R.Top))
    else
      Result.MoveTo(PointF(R.Right, R.Top));
    if TSide.Right in Sides then
      Result.LineTo(PointF(R.Right, R.Top + y1))
    else
      Result.MoveTo(PointF(R.Right, R.Top + y1));
    {$ELSE}
    if TSide.sdTop in Sides then
      Result.LineTo(PointF(R.Right, R.Top))
    else
      Result.MoveTo(PointF(R.Right, R.Top));
    if TSide.sdRight in Sides then
      Result.LineTo(PointF(R.Right, R.Top + y1))
    else
      Result.MoveTo(PointF(R.Right, R.Top + y1));
    {$ENDIF}
  end;

  {$IFDEF DELPHIXE6_LVL}
  if not (TSide.Right in Sides) then
  {$ELSE}
  if not (TSide.sdRight in Sides) then
  {$ENDIF}
    Result.MoveTo(PointF(R.Right, R.Bottom - y1))
  else
  begin
    if (FArrowPosition = paRightCenter) then
    begin
      Result.LineTo(PointF(R.Right, (R.Bottom - R.Top) / 2 -
        (szw / 2)));
      Result.LineTo(PointF(R.Right + szh, (R.Bottom - R.Top) / 2));
      Result.LineTo(PointF(R.Right, (R.Bottom - R.Top) / 2 +
        (szw / 2)));
      Result.LineTo(PointF(R.Right, R.Bottom - y1));
    end
    else if (FArrowPosition = paRightTop) then
    begin
      Result.LineTo(PointF(R.Right, R.Top + szoff + YRadius));
      Result.LineTo(PointF(R.Right + szh, R.Top + YRadius + szoff + (szw / 2)));
      Result.LineTo(PointF(R.Right, R.Top + szoff + YRadius + szw));
      Result.LineTo(PointF(R.Right, R.Bottom - y1));
    end
    else if (FArrowPosition = paRightBottom) then
    begin
      Result.LineTo(PointF(R.Right, R.Bottom - szoff - YRadius - szw));
      Result.LineTo(PointF(R.Right + szh, R.Bottom - YRadius - szoff - (szw / 2)));
      Result.LineTo(PointF(R.Right, R.Bottom - szoff - YRadius));
      Result.LineTo(PointF(R.Right, R.Bottom - y1));
    end
    else
      Result.LineTo(PointF(R.Right, R.Bottom - y1));
  end;

  {$IFDEF DELPHIXE6_LVL}
  if TCorner.BottomRight in Corners then
  begin
    case CornerType of
      // ctRound - default
      TCornerType.Bevel:
        Result.LineTo(PointF(R.Right - x1, R.Bottom));
      TCornerType.InnerRound:
        Result.CurveTo(PointF(R.Right - x2, R.Bottom - y1),
          PointF(R.Right - x1, R.Bottom - y2), PointF(R.Right - x1, R.Bottom));
      TCornerType.InnerLine:
        begin
          Result.LineTo(PointF(R.Right - x2, R.Bottom - y1));
          Result.LineTo(PointF(R.Right - x1, R.Bottom - y2));
          Result.LineTo(PointF(R.Right - x1, R.Bottom));
        end;
  {$ELSE}
  if TCorner.crBottomRight in Corners then
  begin
    case CornerType of
      // ctRound - default
      TCornerType.ctBevel:
        Result.LineTo(PointF(R.Right - x1, R.Bottom));
      TCornerType.ctInnerRound:
        Result.CurveTo(PointF(R.Right - x2, R.Bottom - y1),
          PointF(R.Right - x1, R.Bottom - y2), PointF(R.Right - x1, R.Bottom));
      TCornerType.ctInnerLine:
        begin
          Result.LineTo(PointF(R.Right - x2, R.Bottom - y1));
          Result.LineTo(PointF(R.Right - x1, R.Bottom - y2));
          Result.LineTo(PointF(R.Right - x1, R.Bottom));
        end;
  {$ENDIF}
    else
      Result.CurveTo(PointF(R.Right, R.Bottom - (y2)),
        PointF(R.Right - x2, R.Bottom), PointF(R.Right - x1, R.Bottom))
    end;
  end
  else
  begin
    {$IFDEF DELPHIXE6_LVL}
    if TSide.Right in Sides then
      Result.LineTo(PointF(R.Right, R.Bottom))
    else
      Result.MoveTo(PointF(R.Right, R.Bottom));
    if TSide.Bottom in Sides then
      Result.LineTo(PointF(R.Right - x1, R.Bottom))
    else
      Result.MoveTo(PointF(R.Right - x1, R.Bottom));
    {$ELSE}
    if TSide.sdRight in Sides then
      Result.LineTo(PointF(R.Right, R.Bottom))
    else
      Result.MoveTo(PointF(R.Right, R.Bottom));
    if TSide.sdBottom in Sides then
      Result.LineTo(PointF(R.Right - x1, R.Bottom))
    else
      Result.MoveTo(PointF(R.Right - x1, R.Bottom));
    {$ENDIF}
  end;
  {$IFDEF DELPHIXE6_LVL}
  if not(TSide.Bottom in Sides) then
  {$ELSE}
  if not(TSide.sdBottom in Sides) then
  {$ENDIF}
    Result.MoveTo(PointF(R.Left + x1, R.Bottom))
  else
  begin
    if ArrowPosition = paBottomCenter then
    begin
      Result.LineTo(PointF((R.Right - R.Left) / 2 + (szw / 2), R.Bottom));
      Result.LineTo(PointF((R.Right - R.Left) / 2, R.Bottom + szh));
      Result.LineTo(PointF((R.Right - R.Left) / 2 - (szw / 2), R.Bottom));
      Result.LineTo(PointF(R.Left + x1, R.Bottom));
    end
    else if ArrowPosition = paBottomLeft then
    begin
      Result.LineTo(PointF(R.Left + szoff + szw + XRadius, R.Bottom));
      Result.LineTo(PointF(R.Left + szoff + XRadius + (szw / 2), R.Bottom + szh));
      Result.LineTo(PointF(R.Left + szoff + XRadius, R.Bottom));
      Result.LineTo(PointF(R.Left + x1, R.Bottom));
    end
    else if ArrowPosition = paBottomRight then
    begin
      Result.LineTo(PointF(R.Right - szoff -  XRadius, R.Bottom));
      Result.LineTo(PointF(R.Right - szoff -  XRadius - (szw / 2), R.Bottom + szh));
      Result.LineTo(PointF(R.Right - szoff -  XRadius - szw, R.Bottom));
      Result.LineTo(PointF(R.Left + x1, R.Bottom));
    end
    else
      Result.LineTo(PointF(R.Left + x1, R.Bottom));
  end;
  {$IFDEF DELPHIXE6_LVL}
  if TCorner.BottomLeft in Corners then
  begin
    case CornerType of
      // ctRound - default
      TCornerType.Bevel:
        Result.LineTo(PointF(R.Left, R.Bottom - y1));
      TCornerType.InnerRound:
        Result.CurveTo(PointF(R.Left + x1, R.Bottom - y2),
          PointF(R.Left + x2, R.Bottom - y1), PointF(R.Left, R.Bottom - y1));
      TCornerType.InnerLine:
        begin
          Result.LineTo(PointF(R.Left + x1, R.Bottom - y2));
          Result.LineTo(PointF(R.Left + x2, R.Bottom - y1));
          Result.LineTo(PointF(R.Left, R.Bottom - y1));
        end;
  {$ELSE}
  if TCorner.crBottomLeft in Corners then
  begin
    case CornerType of
      // ctRound - default
      TCornerType.ctBevel:
        Result.LineTo(PointF(R.Left, R.Bottom - y1));
      TCornerType.ctInnerRound:
        Result.CurveTo(PointF(R.Left + x1, R.Bottom - y2),
          PointF(R.Left + x2, R.Bottom - y1), PointF(R.Left, R.Bottom - y1));
      TCornerType.ctInnerLine:
        begin
          Result.LineTo(PointF(R.Left + x1, R.Bottom - y2));
          Result.LineTo(PointF(R.Left + x2, R.Bottom - y1));
          Result.LineTo(PointF(R.Left, R.Bottom - y1));
        end;
  {$ENDIF}
    else
      Result.CurveTo(PointF(R.Left + x2, R.Bottom), PointF(R.Left, R.Bottom - (y2)
        ), PointF(R.Left, R.Bottom - y1))
    end;
  end else
  begin
    {$IFDEF DELPHIXE6_LVL}
    if TSide.Bottom in Sides then
      Result.LineTo(PointF(R.Left, R.Bottom))
    else
      Result.MoveTo(PointF(R.Left, R.Bottom));

    if TSide.Left in Sides then
      Result.LineTo(PointF(R.Left, R.Bottom - y1))
    else
      Result.MoveTo(PointF(R.Left, R.Bottom - y1));
    {$ELSE}
    if TSide.sdBottom in Sides then
      Result.LineTo(PointF(R.Left, R.Bottom))
    else
      Result.MoveTo(PointF(R.Left, R.Bottom));

    if TSide.sdLeft in Sides then
      Result.LineTo(PointF(R.Left, R.Bottom - y1))
    else
      Result.MoveTo(PointF(R.Left, R.Bottom - y1));
    {$ENDIF}
  end;

  {$IFDEF DELPHIXE6_LVL}
  if (TSide.Left in Sides) then
  {$ELSE}
  if (TSide.sdLeft in Sides) then
  {$ENDIF}
  begin
    if ArrowPosition = paLeftCenter then
    begin
      Result.LineTo(PointF(R.Left, (R.Bottom - R.Top) / 2 + (szw / 2)));
      Result.LineTo(PointF(R.Left - szh, (R.Bottom - R.Top) / 2));
      Result.LineTo(PointF(R.Left, (R.Bottom - R.Top) / 2 - (szw / 2)));
      Result.LineTo(PointF(R.Left, R.Top + y1));
    end
    else if ArrowPosition = paLeftTop then
    begin
      Result.LineTo(PointF(R.Left, R.Top + szoff + szw + YRadius));
      Result.LineTo(PointF(R.Left - szh, R.Top + szoff + YRadius + (szw / 2)));
      Result.LineTo(PointF(R.Left, R.Top + szoff + YRadius));
      Result.LineTo(PointF(R.Left, R.Top + y1));
    end
    else if ArrowPosition = paLeftBottom then
    begin
      Result.LineTo(PointF(R.Left, R.Bottom - szoff - YRadius));
      Result.LineTo(PointF(R.Left - szh, R.Bottom - szoff - YRadius - (szw / 2)));
      Result.LineTo(PointF(R.Left, R.Bottom - szoff - YRadius - szw));
      Result.LineTo(PointF(R.Left, R.Top + y1));
    end
    else
      Result.LineTo(PointF(R.Left, R.Top + y1));
  end;

  R := GetShapeRect;
  R.Left := R.Left + Padding.Left;
  R.Top := R.Top + Padding.Top;
  R.Width := R.Width - Padding.Right;
  R.Height := R.Height - Padding.Bottom;

  if csDesigning in ComponentState then
  begin
    cth := FindStyleResource('popupcontainerheader') as TControl;
    if Assigned(cth) and cth.Visible then
      r.Top := r.Top + cth.Height;

    ctf := FindStyleResource('popupcontainerfooter') as TControl;
    if Assigned(ctf) and ctf.Visible then
      r.Bottom := r.Bottom - ctf.Height;

    case ArrowPosition of
      paLeftTop, paLeftCenter, paLeftBottom: r.Left := r.Left + szh;
      paTopLeft, paTopCenter, paTopRight: r.Top := r.Top + szh;
      paRightTop, paRightCenter, paRightBottom: r.Right := r.Right - szh;
      paBottomLeft, paBottomCenter, paBottomRight: r.Bottom := r.Bottom - szh;
    end;
  end;

  if (R.Bottom - r.Top < 0) then
    R.Bottom := r.Top;

  if R.Right - r.Left < 0 then
    r.Right := r.Left;

  Result.AddRectangle(R, 0, 0, AllCorners);
end;

procedure TTMSFMXPopupShape.Paint;
var
  pth: TPathData;
begin
  pth := GetPath;
  Canvas.Fill.Assign(Fill);
  Canvas.Stroke.Assign(Stroke);
  Canvas.FillPath(pth, Opacity);
  Canvas.DrawPath(pth, Opacity);
  pth.Free;
end;

procedure TTMSFMXPopupShape.SetArrowHeight(const Value: Single);
begin
  if FArrowHeight <> Value then
  begin
    FArrowHeight := Value;
    Repaint;
  end;
end;

procedure TTMSFMXPopupShape.SetArrowPosition(
  const Value: TTMSFMXPopupShapeArrowPosition);
begin
  if FArrowPosition <> Value then
  begin
    FArrowPosition := Value;
    Repaint;
  end;
end;

procedure TTMSFMXPopupShape.SetArrowWidth(const Value: Single);
begin
  if FArrowWidth <> Value then
  begin
    FArrowWidth := Value;
    Repaint;
  end;
end;

{ TTMSFMXPopupButton }

function TTMSFMXPopupButton.Button: TTMSFMXBarButton;
begin
  Result := FPopupButton;
end;

constructor TTMSFMXPopupButton.Create(Collection: TCollection);
begin
  inherited;
  FOwner := (Collection as TTMSFMXPopupButtons).FOwner;
  FKind := bkNormal;
  FShowImage := False;
  FShowText := True;
  FWidth := 50;
  FOwner.UpdateButtons;
end;

destructor TTMSFMXPopupButton.Destroy;
begin
  inherited;
  if Assigned(FOwner) then
  begin
    FOwner.UpdateButtons;
  end;
end;

procedure TTMSFMXPopupButton.SetBitmapName(const Value: String);
begin
  if FBitmapName <> Value then
  begin
    FBitmapName := Value;
    if Assigned(PopupButton) then
      PopupButton.BitmapName := Value;
  end;
end;

procedure TTMSFMXPopupButton.SetKind(const Value: TTMSFMXBarButtonKind);
begin
  if FKind <> Value then
  begin
    FKind := Value;
    if Assigned(PopupButton) then
      PopupButton.Kind := Value;
  end;
end;

procedure TTMSFMXPopupButton.SetLayout(
  const Value: TTMSFMXBarButtonShapeLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    if Assigned(PopupButton) then
      PopupButton.Layout := Value;
  end;
end;

procedure TTMSFMXPopupButton.SetShowImage(const Value: Boolean);
begin
  if FShowImage <> Value then
  begin
    FShowImage := Value;
    if Assigned(PopupButton) then
      PopupButton.ShowImage := Value;
  end;
end;

procedure TTMSFMXPopupButton.SetShowText(const Value: Boolean);
begin
  if FShowText <> Value then
  begin
    FShowText := Value;
    if Assigned(PopupButton) then
      PopupButton.ShowText := Value;
  end;
end;

procedure TTMSFMXPopupButton.SetText(const Value: String);
begin
  if FText <> Value then
  begin
    FText := Value;
    if Assigned(PopupButton) then
      PopupButton.Text := Value;
  end;
end;

procedure TTMSFMXPopupButton.SetWidth(const Value: Single);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    if Assigned(PopupButton) then
      PopupButton.Width := Value;
  end;
end;

{ TTMSFMXPopupButtons }

function TTMSFMXPopupButtons.Add: TTMSFMXPopupButton;
begin
  Result := TTMSFMXPopupButton(inherited Add);
end;

constructor TTMSFMXPopupButtons.Create(AOwner: TTMSFMXPopup);
begin
  inherited Create(TTMSFMXPopupButton);
  FOwner := AOwner;
end;

function TTMSFMXPopupButtons.GetItem(Index: Integer): TTMSFMXPopupButton;
begin
  Result := TTMSFMXPopupButton(inherited Items[Index]);
end;

function TTMSFMXPopupButtons.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TTMSFMXPopupButtons.Insert(Index: Integer): TTMSFMXPopupButton;
begin
  Result := TTMSFMXPopupButton(inherited Insert(Index));
end;

procedure TTMSFMXPopupButtons.SetItem(Index: Integer; const Value: TTMSFMXPopupButton);
begin
  inherited Items[Index] := Value;
end;

initialization
  RegisterFmxClasses([TTMSFMXPopup, TTMSFMXPopupShape]);

end.

