Hola
el-mono
No es perfecto pero creo que es un comienzo y luego podes personalizarlo mas a tu manera
Código Delphi
[-]
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
Código Delphi
[-]
procedure TForm1.OnCreate(Sender: TObject);
var
MyFormatSettings: TFormatSettings;
begin
MyFormatSettings := TFormatSettings.Create; MyFormatSettings.CurrencyString := '$'; 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)
Código Delphi
[-]
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:
Código Delphi
[-] 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;