Currency Edit

[el-mono]

Buenas.

Alguien conoce o sabe como mostrar sobre un Tedit de Firemonkey números en formato moneda con el símbolo peso delante inclusive ?

Alguna clase o una orientación sera bienvenida. Gracias gente desde ya.

[AgustinOrtu]

Hola el-mono

No es perfecto pero creo que es un comienzo y luego podes personalizarlo mas a tu manera


unit Unit1;

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
TCurrencyEdit = class(FMX.Edit.TEdit)
strict private
function GetValue: Currency;
function GetDefaultValue: Currency;
function GetFormatSettings: TFormatSettings;

procedure SetValue(const Value: Currency);
procedure SetDefaultValue(const Value: Currency);
procedure SetFormatSettings(const Value: TFormatSettings);
strict protected
procedure SetText(const Value: string); override;
function DefineModelClass: TDataModelClass; override;
public
property FormatSettings: TFormatSettings read GetFormatSettings write SetFormatSettings;
published
property DefaultValue: Currency read GetDefaultValue write SetDefaultValue;
property Value: Currency read GetValue write SetValue;
end;

TCurrencyEditModel = class(TCustomEditModel)
private
FDefaultValue: Currency;
FFormatSettings: TFormatSettings;

procedure SetDefaultValue(const Value: Currency);
procedure SetFormatSettings(const Value: TFormatSettings);
protected
function DoValidate(const Value: string): string; override;
public
constructor Create(const AOwner: TComponent); override;
property DefaultValue: Currency read FDefaultValue write SetDefaultValue;
property FormatSettings: TFormatSettings read FFormatSettings write SetFormatSettings;
end;

TEdit = class(TCurrencyEdit);


TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{$REGION 'TCurrencyEdit'}

function TCurrencyEdit.DefineModelClass: TDataModelClass;
begin
Result := TCurrencyEditModel;
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;

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.SetText(const Value: string);
begin
SetValue(StrToCurrDef(Value, DefaultValue, FormatSettings));
end;

procedure TCurrencyEdit.SetValue(const Value: Currency);
begin
inherited SetText(CurrToStr(Value, FormatSettings));
end;

procedure TCurrencyEditModel.SetDefaultValue(const Value: Currency);
begin
FDefaultValue := Value;
end;

procedure TCurrencyEditModel.SetFormatSettings(const Value: TFormatSettings);
begin
FFormatSettings := Value;
end;

{$ENDREGION}

{$REGION 'TCurrencyEditModel'}

constructor TCurrencyEditModel.Create(const AOwner: TComponent);
begin
inherited Create(AOwner);
FDefaultValue := 0;
FFormatSettings := TFormatSettings.Create;
end;

function TCurrencyEditModel.DoValidate(const Value: string): string;
var
TempValue: Currency;
begin
if not TryStrToCurr(Value, TempValue, FormatSettings) then
TempValue := DefaultValue;

Result := CurrToStrF(TempValue, ffCurrency, FormatSettings.CurrencyDecimals, FormatSettings);
end;

{$ENDREGION}

{$REGION 'Ejemplo'}

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := 'asdasd';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Edit1.Value := 123.45;
end;

{$ENDREGION}

end.


En este ejemplo hago uso del truco de la clase interpuesta para ahorrarme el problema de instalar y registrar el componente (de esto podes encontrar muchisimos ejemplos en la web de como hacerlo) de este modo en mi form todos los TEdit en realidad son instancias de TCurrencyEdit (es un engaño al framework de persistencia ocultando el tipo original TEdit)

En mi caso yo utilizo una variable privada TFormatSettings para definir el formato. La clase en su constructor inicializa este registro usando el locale por defecto. Si necesitas personalizar el formato a tu gusto podes crear tu propio registro TFormatSettings y luego asignarselo al TCurrencyEdit


procedure TForm1.OnCreate(Sender: TObject);
var
MyFormatSettings: TFormatSettings;
begin
MyFormatSettings := TFormatSettings.Create; // hay mas constructores, revisa la documentacion
MyFormatSettings.CurrencyString := '$'; // cambiar las propiedades deseadas
// cambiar mas propiedades
// asignar
Edit1.FormatSettings := MyFormatSettings;
end;


Otra alternativa seria descartar el FormatSettings y usar un mecanismo de callback (un evento) en el que el programador pueda formatear el string como quiera:

El codigo modificado (obviando algun que otro getter/setter trivial)


type
TFormatTextEvent = procedure(Sender: TObject; const Value: Currency; var Text: string) of object;

TCurrencyEdit = class(FMX.Edit.TEdit)
strict private
function GetOnFormatText: TFormatTextEvent;
procedure SetOnFormatText(const Value: TFormatTextEvent);
...
published
property OnFormatText: TFormatTextEvent read GetOnFormatText write SetOnFormatText;
...
end;

TCurrencyEditModel = class(TCustomEditModel)
strict private
FOnFormatText: TFormatTextEvent;
...
procedure SetOnFormatText(const Value: TFormatTextEvent);
strict protected
function DoFormatText(const TempValue: Currency): string; virtual;
public
...
property OnFormatText: TFormatTextEvent read FOnFormatText write SetOnFormatText;
end;

function TCurrencyEdit.GetOnFormatText: TFormatTextEvent;
begin
Result := GetModel< TCurrencyEditModel >.OnFormatText;
end;

procedure TCurrencyEdit.SetOnFormatText(const Value: TFormatTextEvent);
begin
GetModel< TCurrencyEditModel >.OnFormatText := Value;
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;


Uso:

TForm1 = class(TForm)
...
procedure Edit1FormatText(Sender: TObject; const Value: Currency; var Text: string);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.OnFormatText := Edit1FormatText;
end;

procedure TForm1.Edit1FormatText(Sender: TObject; const Value: Currency; var Text: string);
begin
Text := CurrToStrF(Value, ffCurrency, 3);
end;

[el-mono]

Muchísimas Gracias Agustin. Sos muy groso y me sirvió un montón la primera opción.