{********************************************************************}
{                                                                    }
{ 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.TMSPanel;

interface

{$I TMSDEFS.INC}

uses
  SysUtils, Classes, FMX.Types, FMX.Controls, FMX.Objects, Types, UITypes,
  FMX.Ani, FMX.TMSBaseControl, FMX.TMSBitmapContainer, FMX.TMSHTMLText,
  FMX.TMSBitmap, UIConsts, FMX.Styles
  {$IFDEF DELPHIXE5_LVL}
  , FMX.Graphics
  {$ENDIF}
  {$IFDEF DELPHIXE6_LVL}
  , System.Math.Vectors
  {$ENDIF}
  ;

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

  //v1.0.0.0 : First Release
  //v1.0.0.1 : Fixed : Access violation Loading footer at designtime
  //v1.5.0.0 : New : support for XE4
  //v1.5.0.1 : Fixed : Issue with designtime initialization of caption
  //v1.5.0.2 : Fixed : Issue with setting collaps = true at designtime

type
  TTMSFMXPanel = class;
  TPanelButtonType = (pbtClose, pbtMinMax);

  TTMSFMXPanelButtonShape = class(TRoundRect)
  private
    FPanel: TTMSFMXPanel;
    FFillDown: TBrush;
    FStrokeDown: TBrush;
    FStrokeHot: TBrush;
    FFillHot: TBrush;
    FButtonType: TPanelButtonType;
    FMinimized: Boolean;
    FSignColor: TAlphaColor;
    procedure SetFillDown(const Value: TBrush);
    procedure SetStrokeDown(const Value: TBrush);
    function GetIsHot: Boolean;
    procedure SetFillHot(const Value: TBrush);
    procedure SetStrokeHot(const Value: TBrush);
    procedure SetMinimized(const Value: Boolean);
  protected
    procedure DoMouseEnter; override;
    procedure DoMouseLeave; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
    procedure Click; override;
    property IsHot: Boolean read GetIsHot;
    property Panel: TTMSFMXPanel read FPanel write FPanel;
    property Minimized: Boolean read FMinimized write SetMinimized default False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property ButtonType: TPanelButtonType read FButtonType write FButtonType default pbtClose;
    property SignColor: TAlphaColor read FSignColor write FSignColor;
    property StrokeDown: TBrush read FStrokeDown write SetStrokeDown;
    property FillDown: TBrush read FFillDown write SetFillDown;
    property StrokeHot: TBrush read FStrokeHot write SetStrokeHot;
    property FillHot: TBrush read FFillHot write SetFillHot;
    property Fill;
    property Stroke;
    property StrokeThickness;
    property StrokeCap;
    property StrokeDash;
    property StrokeJoin;
  end;

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXPanel = class(TTMSFMXBaseControl)
  private
    FUpdateCount: Integer;
    FBitmapContainer: TTMSFMXBitmapContainer;
    FCollaps: Boolean;
    FStyleApplied: Boolean;
    FFullHeight: Single;
    FFooterVisibled: Boolean;
    FContainerVisibled: Boolean;
    FText: string;
    FCaption: string;
    FFooterText: string;
    FOnMaximize: TNotifyEvent;
    FOnMinimize: TNotifyEvent;
    FOnClose: TNotifyEvent;
    FOnCaptionAnchorClick: TTMSFMXHTMLTextAnchorClickEvent;
    FOnFooterTextAnchorClick: TTMSFMXHTMLTextAnchorClickEvent;
    FOnTextAnchorClick: TTMSFMXHTMLTextAnchorClickEvent;
    procedure OnContainerResize(Sender: TObject);
    procedure OnMinMaxBtnClick(Sender: TObject);
    procedure OnCloseBtnClick(Sender: TObject);
    procedure OnCollapsAnimFinished(Sender: TObject);
    function GetVersion: String;
    function GetVersionNr: Integer;
    procedure SetVersion(const Value: String);
    procedure SetBitmapContainer(const Value: TTMSFMXBitmapContainer);
    procedure SetCollaps(const Value: Boolean);
    procedure SetText(const Value: string);
    procedure SetCaption(const Value: string);
    procedure SetFooterText(const Value: string);
    procedure DoCollaps(const Value: boolean; Animate: boolean = true);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetInstance: NativeUInt; override;
    procedure ApplyStyle; override;
    function GetContainer: TControl;
    function GetHeader: TControl;
    function GetHeaderText: TTMSFMXHTMLText;
    function GetHeaderHeight: Integer;
    function GetFooterHeight: Integer;
    function GetFooter: TControl;
    function GetFooterText: TTMSFMXHTMLText;
    function GetCloseBtn: TTMSFMXPanelButtonShape;
    function GetMinMaxBtn: TTMSFMXPanelButtonShape;
    function GetContainerText: TTMSFMXHTMLText;
    function CollapsAnimation: TFloatAnimation;
    function GetContainerRect: TRectF;
    procedure Resize; override;
    procedure SetWidth(const Value: Single); override;
    procedure SetHeight(const Value: Single); override;
    procedure UpdateCaption;
    procedure UpdateText;
    procedure UpdateFooterText;
    procedure AssignEvents;
    procedure AssignBitmapContainer;
    procedure DoAnchorClickHeader(Sender: TOBject; AAnchor: String);
    procedure DoAnchorClickFooter(Sender: TOBject; AAnchor: String);
    procedure DoAnchorClickContainerText(Sender: TObject; AAnchor: String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginUpdate; override;
    procedure EndUpdate; override;
    procedure SetBounds(X, Y, AWidth, AHeight: Single); override;
    function GetUpdateCount: Integer;
  published
    property BitmapContainer: TTMSFMXBitmapContainer read FBitmapContainer write SetBitmapContainer;
    property Caption: string read FCaption write SetCaption;
    property Collaps: Boolean read FCollaps write SetCollaps default False;
    property Text: string read FText write SetText;
    property FooterText: string read FFooterText write SetFooterText;
    property Version: String read GetVersion write SetVersion;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnMinimize: TNotifyEvent read FOnMinimize write FOnMinimize;
    property OnMaximize: TNotifyEvent read FOnMaximize write FOnMaximize;
    property OnCaptionAnchorClick: TTMSFMXHTMLTextAnchorClickEvent read FOnCaptionAnchorClick write FOnCaptionAnchorClick;
    property OnTextAnchorClick: TTMSFMXHTMLTextAnchorClickEvent read FOnTextAnchorClick write FOnTextAnchorClick;
    property OnFooterTextAnchorClick: TTMSFMXHTMLTextAnchorClickEvent read FOnFooterTextAnchorClick write FOnFooterTextAnchorClick;
  end;


implementation

uses
  Math;

{$R FMX.TMSPanel.res}

//------------------------------------------------------------------------------

{ TTMSFMXPanel }

constructor TTMSFMXPanel.Create(AOwner: TComponent);
begin
  inherited;
  {$IFDEF DELPHIXE6_LVL}
  Fill.Kind := TBrushKind.Solid;
  Stroke.Kind := TBrushKind.Solid;
  {$ELSE}
  Fill.Kind := TBrushKind.bkSolid;
  Stroke.Kind := TBrushKind.bkSolid;
  {$ENDIF}
  Width := 280;
  Height := 380;
  FStyleApplied := false;
  if (csDesigning in ComponentState) and not
    ((csReading in Owner.ComponentState) or (csLoading in Owner.ComponentState)) then
  begin
    FCaption := 'Caption';
  end;
end;

//------------------------------------------------------------------------------

destructor TTMSFMXPanel.Destroy;
begin
  inherited;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.DoAnchorClickContainerText(Sender: TObject;
  AAnchor: String);
begin
  if Assigned(OnTextAnchorClick) then
    OnTextAnchorClick(Sender, AAnchor);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.DoAnchorClickFooter(Sender: TOBject; AAnchor: String);
begin
  if Assigned(OnFooterTextAnchorClick) then
    OnFooterTextAnchorClick(Sender, AAnchor);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.DoAnchorClickHeader(Sender: TOBject; AAnchor: String);
begin
  if Assigned(FOnCaptionAnchorClick) then
    FOnCaptionAnchorClick(Sender, AAnchor);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.BeginUpdate;
begin
  inherited;
  Inc(FUpdateCount);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.EndUpdate;
begin
  Dec(FUpdateCount);
  if not (csDesigning in ComponentState) and not (csLoading in ComponentState) and not not (csReading in ComponentState) then
  begin
  end;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetContainer: TControl;
var
  fmxobj: TFMXObject;
begin
  Result := nil;
  fmxobj := FindStyleResource('container');
  if fmxobj is TControl then
    Result := fmxobj as TControl;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetHeader: TControl;
var
  fmxobj: TFMXObject;
begin
  Result := nil;
  fmxobj := FindStyleResource('header');
  if fmxobj is TControl then
    Result := fmxobj as TControl;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetHeaderHeight: Integer;
var
  c: TControl;
begin
  c := GetHeader;
  if Assigned(c) then
    Result := Round(c.Height)
  else
    Result := 25;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetHeaderText: TTMSFMXHTMLText;
var
  fmxobj: TFMXObject;
  c: TControl;
begin
  Result := nil;
  c := GetHeader;
  if Assigned(c) then
  begin
    fmxobj := c.FindStyleResource('headertext');
    if fmxobj is TTMSFMXHTMLText then
      Result := fmxobj as TTMSFMXHTMLText;
  end;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetFooter: TControl;
var
  fmxobj: TFMXObject;
begin
  Result := nil;
  fmxobj := FindStyleResource('footer');
  if fmxobj is TControl then
    Result := fmxobj as TControl;
end;

function TTMSFMXPanel.GetFooterHeight: Integer;
var
  c: TControl;
begin
  c := GetFooter;
  if Assigned(c) then
    Result := Round(c.Height)
  else
    Result := 25;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetFooterText: TTMSFMXHTMLText;
var
  fmxobj: TFMXObject;
  c: TControl;
begin
  Result := nil;
  c := GetFooter;
  if Assigned(c) then
  begin
    fmxobj := c.FindStyleResource('footertext');
    if fmxobj is TTMSFMXHTMLText then
      Result := fmxobj as TTMSFMXHTMLText;
  end;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetCloseBtn: TTMSFMXPanelButtonShape;
var
  fmxobj: TFMXObject;
  c: TControl;
begin
  Result := nil;
  c := GetHeader;
  if Assigned(c) then
  begin
    fmxobj := c.FindStyleResource('closebutton');
    if fmxobj is TTMSFMXPanelButtonShape then
      Result := fmxobj as TTMSFMXPanelButtonShape;
  end;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetMinMaxBtn: TTMSFMXPanelButtonShape;
var
  fmxobj: TFMXObject;
  c: TControl;
begin
  Result := nil;
  c := GetHeader;
  if Assigned(c) then
  begin
    fmxobj := c.FindStyleResource('minimizebutton');
    if fmxobj is TTMSFMXPanelButtonShape then
      Result := fmxobj as TTMSFMXPanelButtonShape;
  end;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetContainerText: TTMSFMXHTMLText;
var
  fmxobj: TFMXObject;
  c: TControl;
begin
  Result := nil;
  c := GetContainer;
  if Assigned(c) then
  begin
    fmxobj := c.FindStyleResource('containertext');
    if fmxobj is TTMSFMXHTMLText then
      Result := fmxobj as TTMSFMXHTMLText;
  end;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.CollapsAnimation: TFloatAnimation;
var
  fmxobj: TFMXObject;
begin
  Result := nil;
  fmxobj := FindStyleResource('collapsanimation');
  if fmxobj is TFloatAnimation then
    Result := fmxobj as TFloatAnimation;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetContainerRect: TRectF;
var
  c: TControl;
begin
  Result := LocalRect;
  c := GetContainer;
  if Assigned(c) then
  begin
    Result := c.LocalRect;
  end;
end;

//------------------------------------------------------------------------------

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

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.ApplyStyle;
begin
  inherited;
  AssignEvents;
  AssignBitmapContainer;
  UpdateCaption;
  UpdateText;
  UpdateFooterText;
  FStyleApplied := true;
  if FCollaps then
  begin
    FCollaps := false;
    DoCollaps(true,false);
  end;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.GetUpdateCount: Integer;
begin
  Result := FUpdateCount;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanel.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 TTMSFMXPanel.GetVersionNr: integer;
begin
  Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.OnCollapsAnimFinished(Sender: TObject);
begin
  if Collaps then
    SetBounds(Position.X, Position.Y, Width, GetHeaderHeight)
  else
    SetBounds(Position.X, Position.Y, Width, FFullHeight);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.SetCollaps(const Value: Boolean);
begin
  if (FCollaps <> Value) then
  begin
    FCollaps := Value;

    if not FStyleApplied then
      Exit;

    DoCollaps(Value);
  end;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.DoCollaps(const Value: Boolean; Animate: boolean = true);
var
  h: Integer;
  F, C: TControl;
  anim: TFloatAnimation;
begin
  FCollaps := Value;

  F := GetFooter;
  C := GetContainer;
  anim := CollapsAnimation;
  if FCollaps then
  begin
    FFullHeight := Height;
    h := GetHeaderHeight;
    if Assigned(anim) and Animate then
    begin
      anim.Parent := Self;
      anim.PropertyName := 'Height';
      anim.Duration := 0.2;
      anim.OnFinish := OnCollapsAnimFinished;
      anim.StartFromCurrent := True;
      anim.StopValue := h;
      anim.Start;
    end
    else
      SetBounds(Position.X, Position.Y, Width, h);

    if Assigned(F) then
    begin
      FFooterVisibled := F.Visible;
      F.Visible := False;
    end;

    if Assigned(C) then
    begin
      FContainerVisibled := C.Visible;
      C.Visible := False;
    end;
    if Assigned(FOnMinimize) then
      FOnMinimize(Self);
  end
  else // Expand
  begin
    //Height := FFullHeight;
    if Assigned(anim) then
    begin
      anim.Duration := 0.2;
      anim.OnFinish := OnCollapsAnimFinished;
      anim.StartFromCurrent := False;
      anim.StartValue := Min(60, FFullHeight / 4);
      anim.StopValue := FFullHeight;
      anim.Start;
    end
    else
      SetBounds(Position.X, Position.Y, Width, FFullHeight);
    if FFooterVisibled and Assigned(F) then
      F.Visible := True;
    if FContainerVisibled and Assigned(C) then
      C.Visible := True;
    if Assigned(FOnMaximize) then
      FOnMaximize(Self);
  end;

end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.SetFooterText(const Value: string);
begin
  if (FFooterText <> Value) then
  begin
    FFooterText := Value;
    UpdateFooterText;
  end;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.SetHeight(const Value: Single);
begin
  inherited;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.SetText(const Value: string);
begin
  if (FText <> Value) then
  begin
    FText := Value;
    UpdateText;
  end;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.SetCaption(const Value: string);
begin
  if (FCaption <> Value) then
  begin
    FCaption := Value;
    UpdateCaption;
  end;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.UpdateCaption;
var
  ht: TTMSFMXHTMLText;
begin
  ht := GetHeaderText;
  if Assigned(ht) then
    ht.Text := FCaption;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.UpdateFooterText;
var
  t: TTMSFMXHTMLText;
begin
  t := GetFooterText;
  if Assigned(t) then
    t.Text := FFooterText;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.UpdateText;
var
  t: TTMSFMXHTMLText;
begin
  t := GetContainerText;
  if Assigned(t) then
  begin
    t.Text := FText;
    t.Visible := FText <> '';    
  end;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.SetBitmapContainer(const Value: TTMSFMXBitmapContainer);
begin
  FBitmapContainer := Value;
  AssignBitmapContainer;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.OnMinMaxBtnClick(Sender: TObject);
var
  mb: TTMSFMXPanelButtonShape;
begin
  mb := GetMinMaxBtn;
  if Assigned(mb) then
  begin
    if mb.Minimized then
      Collaps := True
    else
      Collaps := False;
  end
  else
    Collaps := not Collaps;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.OnCloseBtnClick(Sender: TObject);
begin
  Visible := False;
  if Assigned(FOnClose) then
    FOnClose(Self);
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.AssignBitmapContainer;
var
  t: TTMSFMXHTMLText;
begin
  t := GetHeaderText;
  if Assigned(t) then
    t.BitmapContainer := BitmapContainer;

  t := GetContainerText;
  if Assigned(t) then
    t.BitmapContainer := BitmapContainer;

  t := GetFooterText;
  if Assigned(t) then
    t.BitmapContainer := BitmapContainer;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.AssignEvents;
var
  C: TControl;
  mb: TTMSFMXPanelButtonShape;
  ht: TTMSFMXHTMLText;
begin
  C := GetContainer;
  if Assigned(C) then
    C.OnResize := OnContainerResize;

  mb := GetCloseBtn;
  if Assigned(mb) then
    mb.OnClick := OnCloseBtnClick;

  mb := GetMinMaxBtn;
  if Assigned(mb) then
    mb.OnClick := OnMinMaxBtnClick;

  ht := GetHeaderText;
  if Assigned(ht) then
    ht.OnAnchorClick := DoAnchorClickHeader;

  ht := GetContainerText;
  if Assigned(ht) then
    ht.OnAnchorClick := DoAnchorClickContainerText;

  ht := GetFooterText;
  if Assigned(ht) then
    ht.OnAnchorClick := DoAnchorClickFooter;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.OnContainerResize(Sender: TObject);
begin

end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.Resize;
begin
  inherited;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.SetWidth(const Value: Single);
begin
  inherited;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.SetBounds(X, Y, AWidth, AHeight: Single);
begin
  inherited;

end;

//------------------------------------------------------------------------------

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

end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FBitmapContainer) then
    FBitmapContainer := nil;

  inherited;

  if (Operation = opRemove) and not (csDestroying in ComponentState) then
  begin
  end;

end;

//------------------------------------------------------------------------------

{ TTMSFMXPanelButtonShape }

constructor TTMSFMXPanelButtonShape.Create(AOwner: TComponent);
begin
  inherited;
  Height := 20;
  Width := 20;
  DesignVisible := True;
  HitTest := True;
  Corners := [];
  FSignColor := TAlphaColor($FF676D75);
  FButtonType := pbtClose;
  {$IFDEF DELPHIXE6_LVL}
  FFillDown := TBrush.Create(TBrushKind.Solid, claWhite);
  FStrokeDown := TBrush.Create(TBrushKind.Solid, claBlack);
  FFillHot := TBrush.Create(TBrushKind.Solid, claWhite);
  FStrokeHot := TBrush.Create(TBrushKind.Solid, claBlack);
  {$ELSE}
  FFillDown := TBrush.Create(TBrushKind.bkSolid, claWhite);
  FStrokeDown := TBrush.Create(TBrushKind.bkSolid, claBlack);
  FFillHot := TBrush.Create(TBrushKind.bkSolid, claWhite);
  FStrokeHot := TBrush.Create(TBrushKind.bkSolid, claBlack);
  {$ENDIF}
end;

//------------------------------------------------------------------------------

destructor TTMSFMXPanelButtonShape.Destroy;
begin
  FStrokeDown.Free;
  FFillDown.Free;
  FStrokeHot.Free;
  FFillHot.Free;
  inherited;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.Click;
begin
  Minimized := not Minimized;
  inherited;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.DoMouseEnter;
begin
  inherited;
  if Enabled then
    Repaint;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.DoMouseLeave;
begin
  inherited;
  if Enabled then
    Repaint;
end;

//------------------------------------------------------------------------------

function TTMSFMXPanelButtonShape.GetIsHot: Boolean;
begin
  Result := IsMouseOver and Enabled;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  inherited;
  if FPressed then
    Repaint;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.MouseMove(Shift: TShiftState; X, Y: Single);
begin
  inherited;

end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  inherited;
  Repaint;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.Paint;
var
  R: TRectF;
  Radius: Single;
  P : TPolygon;
begin
  if FPressed then
  begin
    Canvas.Fill.Assign(FillDown);
    Canvas.Stroke.Assign(StrokeDown);
  end
  else if IsHot then
  begin
    Canvas.Fill.Assign(FillHot);
    Canvas.Stroke.Assign(StrokeHot);
  end
  else
  begin
    Canvas.Stroke.Assign(Stroke);
    Canvas.Fill.Assign(Fill);
  end;

  R := GetShapeRect;
  if Height < Width then
    Radius := RectHeight(R) / 2
  else
    Radius := RectWidth(R) / 2;
  Canvas.StrokeThickness := 1.0;
  Canvas.FillRect(R, Radius, Radius, Corners, Opacity);
  Canvas.DrawRect(R, Radius, Radius, Corners, Opacity);

  Canvas.Stroke.Color := SignColor;
  if (ButtonType = pbtClose) then
  begin
    {$IFDEF DELPHIXE6_LVL}
    Canvas.Stroke.Kind := TBrushKind.Solid;
    {$ELSE}
    Canvas.Stroke.Kind := TBrushKind.bkSolid;
    {$ENDIF}
    Canvas.StrokeThickness := 2.0;
    Canvas.DrawLine(PointF(R.Left + 7, R.Top + 7), PointF(R.Right - 7, R.Bottom - 7), AbsoluteOpacity);
    Canvas.DrawLine(PointF(R.Right - 7, R.Top + 7), PointF(R.Left + 7, R.Bottom - 7), AbsoluteOpacity);
  end
  else
  begin
    Canvas.Fill.Color := SignColor;
    {$IFDEF DELPHIXE6_LVL}
    Canvas.Fill.Kind := TBrushKind.Solid;
    {$ELSE}
    Canvas.Fill.Kind := TBrushKind.bkSolid;
    {$ENDIf}
    SetLength(P, 4);
    if Minimized then
    begin
      P[0] := PointF(R.Left + R.Width / 2, R.Bottom - 7);
      P[1] := PointF(R.Left + 5, R.Top + 8);
      P[2] := PointF(R.Right - 5, R.Top + 8);
      P[3] := P[0];
    end
    else
    begin
      P[0] := PointF(R.Left + R.Width / 2, R.Top + 8);
      P[1] := PointF(R.Left + 5, R.Bottom - 7);
      P[2] := PointF(R.Right - 5, R.Bottom - 7);
      P[3] := P[0];
    end;
    Canvas.FillPolygon(P, AbsoluteOpacity);
  end;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.SetFillDown(const Value: TBrush);
begin
  FFillDown.Assign(Value);
  Repaint;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.SetFillHot(const Value: TBrush);
begin
  FFillHot.Assign(Value);
  Repaint;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.SetMinimized(const Value: Boolean);
begin
  if (FMinimized <> Value) then
  begin
    FMinimized := Value;
    Repaint;
  end;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.SetStrokeDown(const Value: TBrush);
begin
  FStrokeDown.Assign(Value);
  Repaint;
end;

//------------------------------------------------------------------------------

procedure TTMSFMXPanelButtonShape.SetStrokeHot(const Value: TBrush);
begin
  FStrokeHot.Assign(Value);
  Repaint;
end;

//------------------------------------------------------------------------------


initialization
begin
  RegisterFmxClasses([TTMSFMXPanel, TTMSFMXPanelButtonShape]);
end;

end.
