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

interface

{$I TMSDEFS.INC}

uses
  Classes, Types, SysUtils, FMX.Types, FMX.TMSBaseControl,
  FMX.Edit, FMX.Objects, FMX.Layouts, FMX.Controls
  , FMX.StdCtrls
  , UIConsts, FMX.Styles
  ;

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.5.0.0 : New : support for XE4

type
  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXProgressBar = class(TProgressBar)
  private
    FShowText: Boolean;
    FFormat: String;
    function GetVersion: String;
    function GetVersionNr: Integer;
    procedure SetVersion(const Value: String);
    procedure SetShowText(const Value: Boolean);
    procedure SetFormat(const Value: String);
  protected
    procedure UpdateText;
    procedure ApplyStyle; override;
    function GetClassName: String; virtual;
    function GetClassStyleName: String; virtual;
    function GetStyleObject: TFMXObject; override;
    function LoadFromResource: TFMXObject;
  public
    constructor Create(AOwner: TComponent); override;
    function GetText: TText;
    procedure DoRealign; override;
  published
    property ShowText: Boolean read FShowText write SetShowText default True;
    property Format: String read FFormat write SetFormat;
    property Version: String read GetVersion write SetVersion;
  end;

implementation

{$R FMX.TMSProgressBar.res}

{ TTMSFMXProgressBar }

procedure TTMSFMXProgressBar.ApplyStyle;
begin
  inherited;
  UpdateText;
end;

constructor TTMSFMXProgressBar.Create(AOwner: TComponent);
begin
  inherited;
  FShowText := True;
  FFormat := '0';
end;

function TTMSFMXProgressBar.GetText: TText;
begin
  Result := FindStyleResource('progresstext') as TText;
end;

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

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

function TTMSFMXProgressBar.GetStyleObject: TFmxObject;
var
  obj: TFmxObject;
begin
  obj := inherited GetStyleObject;
  if Assigned(obj) and (obj.ClassType = TLayout) then
  begin
    obj.Free;
    obj := LoadFromResource;
  end;

  Result := obj;
end;

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

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

procedure TTMSFMXProgressBar.DoRealign;
begin
  inherited;
  UpdateText;
end;

procedure TTMSFMXProgressBar.SetFormat(const Value: String);
begin
  FFormat := Value;
  UpdateText;
end;

procedure TTMSFMXProgressBar.SetShowText(const Value: Boolean);
begin
  FShowText := Value;
  UpdateText;
end;

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

end;

procedure TTMSFMXProgressBar.UpdateText;
var
  txt: TText;
begin
  txt := GetText;
  if Assigned(txt) then
  begin
    txt.Visible := ShowText;
    txt.Text := FormatFloat(Format, Value);
  end;
end;

initialization
  RegisterFmxClasses([TTMSFMXProgressBar]);

end.
