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

interface

{$I TMSDEFS.INC}

uses
  Classes, Types, SysUtils, FMX.Controls, UITypes, FMX.TMSBaseControl,
  FMX.Ani, FMX.Effects, FMX.Types, FMX.Objects, FMX.Layouts, FMX.TMSBitmap,
  FMX.TMSBitmapContainer, FMX.TMSHTMLText, FMX.StdCtrls, UIConsts, FMX.Styles
  {$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 = 0; // Build nr.

  // version history
  // v1.0.0.0 : First Release
  // v1.0.0.1 : Improved : TMSIOS define
  // v1.5.0.0 : New : support for XE4

type
  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXSpeedButton = class(TSpeedButton)
  private
    FShowImage: Boolean;
    FBitmapContainer: TTMSFMXBitmapContainer;
    FBitmap: TBitmap;
    FBitmapName: String;
    FLinkedImage: TImage;
    FShowText: Boolean;
    FIsChecked: Boolean;
    FGroupName: String;
    FOnChange: TNotifyEvent;
    procedure SetBitmap(const Value: TBitmap);
    procedure SetBitmapContainer(const Value: TTMSFMXBitmapContainer);
    procedure SetBitmapName(const Value: String);
    procedure SetLinkedImage(const Value: TImage);
    procedure SetShowImage(const Value: Boolean);
    function GetVersion: String;
    function GetVersionNr: Integer;
    procedure SetVersion(const Value: String);
    procedure SetShowText(const Value: Boolean);
    procedure SetIsChecked(const Value: Boolean);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetClassName: String; virtual;
    function GetClassStyleName: String; virtual;
    procedure ApplyStyle; override;
    function GetStyleObject: TFMXObject; override;
    function LoadFromResource: TFMXObject;
  public
    procedure RecalcEnabled; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetBackGround: TRectangle;
    function GetImage: TTMSFMXBitmap;
    function GetText: TText;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
  published
    property Text;
    property BitmapContainer: TTMSFMXBitmapContainer read FBitmapContainer write SetBitmapContainer;
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property BitmapName: String read FBitmapName write SetBitmapName;
    property ShowImage: Boolean read FShowImage write SetShowImage default False;
    property ShowText: Boolean read FShowText write SetShowText default True;
    property LinkedImage: TImage read FLinkedImage write SetLinkedImage;
    property Version: String read GetVersion write SetVersion;
    property IsChecked: Boolean read FIsChecked write SetIsChecked default False;
    property GroupName: String read FGroupName write FGroupName;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property TabOrder;
  end;

implementation

{$R FMX.TMSSpeedButton.res}

{ TTMSFMXSpeedButton }

procedure TTMSFMXSpeedButton.ApplyStyle;
var
  shp: TTMSFMXBitmap;
  shptxt: TText;
begin
  inherited;

  shp := GetImage;
  if Assigned(shp) then
  begin
    shp.Visible := ShowImage;
    shp.BitmapName := BitmapName;
    shp.Bitmap.Assign(Bitmap);
    shp.BitmapContainer := BitmapContainer;
    shp.LinkedImage := LinkedImage;
    if Enabled then
      shp.Opacity := 1
    else
      shp.Opacity := 0.5;
  end;

  shptxt := GetText;
  if Assigned(shptxt) then
  begin
    shptxt.Visible := ShowText;
    if (shptxt is TTMSFMXHTMLText) then
      (shptxt as TTMSFMXHTMLText).BitmapContainer := BitmapContainer;
  end;

  ShowImage := ShowImage;
  ShowText := ShowText;
  IsChecked := IsChecked;
end;

constructor TTMSFMXSpeedButton.Create(AOwner: TComponent);
begin
  inherited;
  Width := 140;
  Height := 30;
  FShowImage := False;
  FShowText := True;
  FBitmap := TBitmap.Create(0, 0);
  CanFocus := True;
end;

destructor TTMSFMXSpeedButton.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

function TTMSFMXSpeedButton.GetBackGround: TRectangle;
begin
  Result := FindStyleResource('background') as TRectangle;
end;

function TTMSFMXSpeedButton.GetClassName: String;
begin
  Result := ClassName;
end;

function TTMSFMXSpeedButton.GetClassStyleName: String;
begin
  Result := GetClassName + 'style';
  Delete(Result, 1, 1);
end;

function TTMSFMXSpeedButton.GetImage: TTMSFMXBitmap;
begin
  Result := FindStyleResource('image') as TTMSFMXBitmap;
end;

function TTMSFMXSpeedButton.GetStyleObject: TFMXObject;
var
  obj: TFMXObject;
begin
  obj := inherited GetStyleObject;
  if not (csDestroying in ComponentState) then
  begin
    if Assigned(obj) and (obj.ClassType = TLayout) and not Assigned(obj.FindStyleResource('layoutoverride')) then
    begin
      obj.Free;
      obj := LoadFromResource;
    end;
  end;

  Result := obj;
end;

function TTMSFMXSpeedButton.GetText: TText;
begin
  Result := FindStyleResource('text') as TText;
end;

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


function TTMSFMXSpeedButton.LoadFromResource: TFMXObject;
var
  str: String;
begin
  Result := nil;
  // create resource class name
  str := GetClassStyleName;
  if FindRCData(HInstance, str) then
  begin
    {$IFDEF DELPHIXE6_LVL}
    Result := TStyleStreaming.LoadFromResource(HInstance, str, RT_RCDATA);
    {$ELSE}
    Result := TStyleManager.LoadFromResource(HInstance, str, RT_RCDATA);
    {$ENDIF}
  end;
end;

procedure TTMSFMXSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  inherited;
  if StaysPressed then
    IsChecked := IsPressed;
end;

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

procedure TTMSFMXSpeedButton.RecalcEnabled;
var
  shp: TTMSFMXBitmap;
begin
  inherited;
  shp := GetImage;
  if Assigned(shp) then
  begin
    if Enabled then
      shp.Opacity := 1
    else
      shp.Opacity := 0.5;
  end;
end;

procedure TTMSFMXSpeedButton.SetBitmap(const Value: TBitmap);
var
  shp: TTMSFMXBitmap;
begin
  FBitmap.Assign(Value);
  shp := GetImage;
  if Assigned(shp) then
    shp.Bitmap.Assign(Value);
end;

procedure TTMSFMXSpeedButton.SetBitmapContainer(
  const Value: TTMSFMXBitmapContainer);
var
  shp: TTMSFMXBitmap;
begin
  FBitmapContainer := Value;
  shp := GetImage;
  if Assigned(shp) then
    shp.BitmapContainer := Value;
end;

procedure TTMSFMXSpeedButton.SetBitmapName(const Value: String);
var
  shp: TTMSFMXBitmap;
begin
  FBitmapName := Value;
  shp := GetImage;
  if Assigned(shp) then
    shp.BitmapName := Value;
  if (csDesigning in ComponentState) then
    ShowImage := Value <> '';
end;

procedure TTMSFMXSpeedButton.SetIsChecked(const Value: Boolean);
var
  bkg: TControl;
  List: TFmxObjectList;
  LUncheck: TFmxObjectList;
  i, C, cc: Integer;
begin
  FIsChecked := Value;
  IsPressed := IsChecked;
  bkg := GetBackGround;
  if Assigned(bkg) then
  begin
    if IsPressed then
      bkg.Opacity := 1
    else
      bkg.Opacity := 0;
  end;

  // allows check/uncheck in design-mode
  if (csDesigning in ComponentState) and FIsChecked then
    FIsChecked := Value
  else
  begin
    if Value then
      FIsChecked := Value;
    { group }
    C := 0;
    cc := 0;

    if (Root <> nil) and (Root.GetObject <> nil) then
    begin
      List := TFmxObjectList.Create;
      LUncheck := TFmxObjectList.Create;
      try
        Root.GetObject.AddObjectsToList(List);
        for i := 0 to List.Count - 1 do
          if (TFmxObject(List[i]) is TTMSFMXSpeedButton) and (TFmxObject(List[i]) <> Self) and
            (TTMSFMXSpeedButton(List[i]).CheckForAllowFocus) and (TTMSFMXSpeedButton(List[i]).GroupName = GroupName) then
          begin
            if TTMSFMXSpeedButton(List[i]).IsChecked then
              cc := cc + 1;
            if Value then
              LUncheck.Add(List[i]);
            C := C + 1;
          end;
        for i := 0 to LUncheck.Count - 1 do
          TTMSFMXSpeedButton(LUncheck[i]).IsChecked := False;
      finally
        List.Free;
        LUncheck.Free;
      end;
    end;

    { check }
    if not Value and (C = 0) then
      Exit;
    if not Value and (cc = 0) then
      Exit;
    FIsChecked := Value;
  end;
  { event }
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TTMSFMXSpeedButton.SetLinkedImage(const Value: TImage);
var
  shp: TTMSFMXBitmap;
begin
  FLinkedImage := Value;
  shp := GetImage;
  if Assigned(shp) then
    shp.LinkedImage := Value;
end;

procedure TTMSFMXSpeedButton.SetShowImage(const Value: Boolean);
var
  shp: TTMSFMXBitmap;
begin
  FShowImage := Value;
  shp := GetImage;
  if Assigned(shp) then
  begin
    shp.Visible := Value;
    if ShowText then
      {$IFDEF DELPHIXE6_LVL}
      shp.Align := TAlignLayout.Left;
      {$ELSE}
      shp.Align := TAlignLayout.alLeft;
      {$ENDIF}
  end;
end;

procedure TTMSFMXSpeedButton.SetShowText(const Value: Boolean);
var
  shp: TText;
  shpImg: TTMSFMXBitmap;
begin
  FShowText := Value;
  shp := GetText;
  if Assigned(shp) then
  begin
    shp.Visible := Value;
    if ShowImage then
    begin
      shpImg := GetImage;
      if Assigned(shpImg) then
      begin
        if ShowText then
        begin
          {$IFDEF DELPHIXE6_LVL}
          shpImg.Align := TAlignLayout.Left;
          {$ELSE}
          shpImg.Align := TAlignLayout.alLeft;
          {$ENDIF}
          shpImg.Width := 20
        end
        else
          {$IFDEF DELPHIXE6_LVL}
          shpImg.Align := TAlignLayout.Client;
          {$ELSE}
          shpImg.Align := TAlignLayout.alClient;
          {$ENDIF}
      end;
    end;
  end;
end;

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

end;

initialization
  RegisterFmxClasses([TTMSFMXSpeedButton]);

end.
