Currency Edit

interface
 
uses
  System.Classes,
  System.SysUtils,
  FMX.Types,
  FMX.Controls,
  FMX.Controls.Model,
  FMX.Forms,
  FMX.Graphics,
  FMX.Controls.Presentation,
  FMX.Edit,
  FMX.StdCtrls;
 
type
{$REGION 'TCurrencyEdit'}
  TFormatTextEvent = procedure(Sender: TObject; const Value: Currency; var Text: string) of object;
 
  TCurrencyEdit = class(FMX.Edit.TEdit)
  strict private
    function GetValue: Currency;
    function GetDefaultValue: Currency;
    function GetFormatSettings: TFormatSettings;
    function GetOnFormatText: TFormatTextEvent;
 
    procedure SetValue(const Value: Currency);
    procedure SetDefaultValue(const Value: Currency);
    procedure SetFormatSettings(const Value: TFormatSettings);
    procedure SetOnFormatText(const Value: TFormatTextEvent);
  strict protected
    procedure SetText(const Value: string); override;
    function DefineModelClass: TDataModelClass; override;
  public
    property FormatSettings: TFormatSettings read GetFormatSettings write SetFormatSettings;
  published
    property OnFormatText: TFormatTextEvent read GetOnFormatText write SetOnFormatText;
    property DefaultValue: Currency read GetDefaultValue write SetDefaultValue;
    property Value: Currency read GetValue write SetValue;
  end;
 
  TCurrencyEditModel = class(TCustomEditModel)
  private
    FDefaultValue: Currency;
    FFormatSettings: TFormatSettings;
    FOnFormatText: TFormatTextEvent;
 
    procedure SetDefaultValue(const Value: Currency);
    procedure SetFormatSettings(const Value: TFormatSettings);
	  procedure SetOnFormatText(const Value: TFormatTextEvent);
  protected
    function DoValidate(const Value: string): string; override;
	  function DoFormatText(const TempValue: Currency): string; virtual;
  public
    constructor Create(const AOwner: TComponent); override;
    property DefaultValue: Currency read FDefaultValue write SetDefaultValue;
    property FormatSettings: TFormatSettings read FFormatSettings write SetFormatSettings;
	property OnFormatText: TFormatTextEvent read FOnFormatText write SetOnFormatText;
  end;
{$ENDREGION}
 
implementation
 
{$REGION 'TCurrencyEdit'}
 
function TCurrencyEdit.DefineModelClass: TDataModelClass;
begin
  Result := TCurrencyEditModel;
end;
 
procedure TCurrencyEdit.SetText(const Value: string);
begin
  SetValue(StrToCurrDef(Value, DefaultValue, FormatSettings));
end;
 
procedure TCurrencyEdit.SetValue(const Value: Currency);
begin
  inherited SetText(CurrToStr(Value, FormatSettings));
end;
 
function TCurrencyEdit.GetDefaultValue: Currency;
begin
  Result := GetModel<TCurrencyEditModel>.DefaultValue;
end;
 
function TCurrencyEdit.GetFormatSettings: TFormatSettings;
begin
  Result := GetModel<TCurrencyEditModel>.FormatSettings;
end;
 
function TCurrencyEdit.GetValue: Currency;
begin
  Result := StrToCurrDef(Text, DefaultValue, FormatSettings);
end;
 
function TCurrencyEdit.GetOnFormatText: TFormatTextEvent;
begin
  Result := GetModel<TCurrencyEditModel>.OnFormatText;
end;
 
procedure TCurrencyEdit.SetDefaultValue(const Value: Currency);
begin
  GetModel<TCurrencyEditModel>.DefaultValue := Value;
end;
 
procedure TCurrencyEdit.SetFormatSettings(const Value: TFormatSettings);
begin
  GetModel<TCurrencyEditModel>.FormatSettings := Value;
end;
 
procedure TCurrencyEdit.SetOnFormatText(const Value: TFormatTextEvent);
begin
  GetModel<TCurrencyEditModel>.OnFormatText := Value;
end;
 
{$ENDREGION}
 
{$REGION 'TCurrencyEditModel'}
 
constructor TCurrencyEditModel.Create(const AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDefaultValue := 0;
  FFormatSettings := TFormatSettings.Create;
end;
 
function TCurrencyEditModel.DoFormatText(const TempValue: Currency): string;
begin
  if Assigned(FOnFormatText) then
    FOnFormatText(Self, TempValue, Result)
  else
    Result := CurrToStrF(TempValue, ffCurrency, FormatSettings.CurrencyDecimals, FormatSettings);
end;
 
function TCurrencyEditModel.DoValidate(const Value: string): string;
var
  TempValue: Currency;
begin
  if not TryStrToCurr(Value, TempValue, FormatSettings) then
    TempValue := DefaultValue;
 
  Result := DoFormatText(TempValue);
end;
 
procedure TCurrencyEditModel.SetDefaultValue(const Value: Currency);
begin
  FDefaultValue := Value;
end;
 
procedure TCurrencyEditModel.SetFormatSettings(const Value: TFormatSettings);
begin
  FFormatSettings := Value;
end;
 
procedure TCurrencyEditModel.SetOnFormatText(const Value: TFormatTextEvent);
begin
  FOnFormatText := Value;
end;
 
{$ENDREGION}

interface
 
type
  // componentes TCurrencyEdit y TCurrencyEditModel
 
  TEdit = class(TCurrencyEdit);
 
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Edit1FormatText(Sender: TObject; const Value: Currency; var Text: string);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;
 
var
  Form1: TForm1;
 
implementation
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := 'asdasd'; // --> $ 0.00
  Edit2.Text := 'asdasd'; // --> $ 100.00
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Edit1.Value := 123.456;
  Edit2.Value := 123.45;
end;
 
procedure TForm1.Edit1FormatText(Sender: TObject; const Value: Currency; var Text: string);
begin
  Text := CurrToStrF(Value, ffCurrency, 3);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  MyFormatSettings: TFormatSettings;
begin
  Edit1.OnFormatText := Edit1FormatText;
 
  MyFormatSettings := TFormatSettings.Create; // hay mas constructores, revisar la documentacion
  MyFormatSettings.CurrencyString := '$'; // cambiar las propiedades deseadas
  // cambiar mas propiedades
  // asignar
  Edit2.FormatSettings := MyFormatSettings;
  Edit2.DefaultValue := 100;
end;