Ir al contenido


Foto

Currency Edit


  • Por favor identifícate para responder
2 respuestas en este tema

#1 el-mono

el-mono

    Advanced Member

  • Miembros
  • PipPipPip
  • 140 mensajes

Escrito 21 febrero 2017 - 02:42

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.


  • 0

#2 Agustin Ortu

Agustin Ortu

    Advanced Member

  • Moderadores
  • PipPipPip
  • 831 mensajes
  • LocationArgentina

Escrito 21 febrero 2017 - 05:43

Si bien aca respondi esta consulta me parece adecuado tambien publicarlo en Delphi Access

 

Puede haber alguna cuestion menor pero en lineas generales me parece un buen punto de partida:


delphi
  1. interface
  2.  
  3. uses
  4. System.Classes,
  5. System.SysUtils,
  6. FMX.Types,
  7. FMX.Controls,
  8. FMX.Controls.Model,
  9. FMX.Forms,
  10. FMX.Graphics,
  11. FMX.Controls.Presentation,
  12. FMX.Edit,
  13. FMX.StdCtrls;
  14.  
  15. type
  16. {$REGION 'TCurrencyEdit'}
  17. TFormatTextEvent = procedure(Sender: TObject; const Value: Currency; var Text: string) of object;
  18.  
  19. TCurrencyEdit = class(FMX.Edit.TEdit)
  20. strict private
  21. function GetValue: Currency;
  22. function GetDefaultValue: Currency;
  23. function GetFormatSettings: TFormatSettings;
  24. function GetOnFormatText: TFormatTextEvent;
  25.  
  26. procedure SetValue(const Value: Currency);
  27. procedure SetDefaultValue(const Value: Currency);
  28. procedure SetFormatSettings(const Value: TFormatSettings);
  29. procedure SetOnFormatText(const Value: TFormatTextEvent);
  30. strict protected
  31. procedure SetText(const Value: string); override;
  32. function DefineModelClass: TDataModelClass; override;
  33. public
  34. property FormatSettings: TFormatSettings read GetFormatSettings write SetFormatSettings;
  35. published
  36. property OnFormatText: TFormatTextEvent read GetOnFormatText write SetOnFormatText;
  37. property DefaultValue: Currency read GetDefaultValue write SetDefaultValue;
  38. property Value: Currency read GetValue write SetValue;
  39. end;
  40.  
  41. TCurrencyEditModel = class(TCustomEditModel)
  42. private
  43. FDefaultValue: Currency;
  44. FFormatSettings: TFormatSettings;
  45. FOnFormatText: TFormatTextEvent;
  46.  
  47. procedure SetDefaultValue(const Value: Currency);
  48. procedure SetFormatSettings(const Value: TFormatSettings);
  49. procedure SetOnFormatText(const Value: TFormatTextEvent);
  50. protected
  51. function DoValidate(const Value: string): string; override;
  52. function DoFormatText(const TempValue: Currency): string; virtual;
  53. public
  54. constructor Create(const AOwner: TComponent); override;
  55. property DefaultValue: Currency read FDefaultValue write SetDefaultValue;
  56. property FormatSettings: TFormatSettings read FFormatSettings write SetFormatSettings;
  57. property OnFormatText: TFormatTextEvent read FOnFormatText write SetOnFormatText;
  58. end;
  59. {$ENDREGION}
  60.  
  61. implementation
  62.  
  63. {$REGION 'TCurrencyEdit'}
  64.  
  65. function TCurrencyEdit.DefineModelClass: TDataModelClass;
  66. begin
  67. Result := TCurrencyEditModel;
  68. end;
  69.  
  70. procedure TCurrencyEdit.SetText(const Value: string);
  71. begin
  72. SetValue(StrToCurrDef(Value, DefaultValue, FormatSettings));
  73. end;
  74.  
  75. procedure TCurrencyEdit.SetValue(const Value: Currency);
  76. begin
  77. inherited SetText(CurrToStr(Value, FormatSettings));
  78. end;
  79.  
  80. function TCurrencyEdit.GetDefaultValue: Currency;
  81. begin
  82. Result := GetModel<TCurrencyEditModel>.DefaultValue;
  83. end;
  84.  
  85. function TCurrencyEdit.GetFormatSettings: TFormatSettings;
  86. begin
  87. Result := GetModel<TCurrencyEditModel>.FormatSettings;
  88. end;
  89.  
  90. function TCurrencyEdit.GetValue: Currency;
  91. begin
  92. Result := StrToCurrDef(Text, DefaultValue, FormatSettings);
  93. end;
  94.  
  95. function TCurrencyEdit.GetOnFormatText: TFormatTextEvent;
  96. begin
  97. Result := GetModel<TCurrencyEditModel>.OnFormatText;
  98. end;
  99.  
  100. procedure TCurrencyEdit.SetDefaultValue(const Value: Currency);
  101. begin
  102. GetModel<TCurrencyEditModel>.DefaultValue := Value;
  103. end;
  104.  
  105. procedure TCurrencyEdit.SetFormatSettings(const Value: TFormatSettings);
  106. begin
  107. GetModel<TCurrencyEditModel>.FormatSettings := Value;
  108. end;
  109.  
  110. procedure TCurrencyEdit.SetOnFormatText(const Value: TFormatTextEvent);
  111. begin
  112. GetModel<TCurrencyEditModel>.OnFormatText := Value;
  113. end;
  114.  
  115. {$ENDREGION}
  116.  
  117. {$REGION 'TCurrencyEditModel'}
  118.  
  119. constructor TCurrencyEditModel.Create(const AOwner: TComponent);
  120. begin
  121. inherited Create(AOwner);
  122. FDefaultValue := 0;
  123. FFormatSettings := TFormatSettings.Create;
  124. end;
  125.  
  126. function TCurrencyEditModel.DoFormatText(const TempValue: Currency): string;
  127. begin
  128. if Assigned(FOnFormatText) then
  129. FOnFormatText(Self, TempValue, Result)
  130. else
  131. Result := CurrToStrF(TempValue, ffCurrency, FormatSettings.CurrencyDecimals, FormatSettings);
  132. end;
  133.  
  134. function TCurrencyEditModel.DoValidate(const Value: string): string;
  135. var
  136. TempValue: Currency;
  137. begin
  138. if not TryStrToCurr(Value, TempValue, FormatSettings) then
  139. TempValue := DefaultValue;
  140.  
  141. Result := DoFormatText(TempValue);
  142. end;
  143.  
  144. procedure TCurrencyEditModel.SetDefaultValue(const Value: Currency);
  145. begin
  146. FDefaultValue := Value;
  147. end;
  148.  
  149. procedure TCurrencyEditModel.SetFormatSettings(const Value: TFormatSettings);
  150. begin
  151. FFormatSettings := Value;
  152. end;
  153.  
  154. procedure TCurrencyEditModel.SetOnFormatText(const Value: TFormatTextEvent);
  155. begin
  156. FOnFormatText := Value;
  157. end;
  158.  
  159. {$ENDREGION}

Como mencionaba en CD, no hice la instalacion propiamente del componente (procedimiento Register) ni el paquete ni nada

 

Ejemplo de uso: en este caso utilizo el truco de la clase interpuesta para engañar a Delphi:


delphi
  1. interface
  2.  
  3. type
  4. // componentes TCurrencyEdit y TCurrencyEditModel
  5.  
  6. TEdit = class(TCurrencyEdit);
  7.  
  8. TForm1 = class(TForm)
  9. Edit1: TEdit;
  10. Edit2: TEdit;
  11. Button1: TButton;
  12. Button2: TButton;
  13. procedure Edit1FormatText(Sender: TObject; const Value: Currency; var Text: string);
  14. procedure FormCreate(Sender: TObject);
  15. procedure Button1Click(Sender: TObject);
  16. procedure Button2Click(Sender: TObject);
  17. end;
  18.  
  19. var
  20. Form1: TForm1;
  21.  
  22. implementation
  23.  
  24. procedure TForm1.Button1Click(Sender: TObject);
  25. begin
  26. Edit1.Text := 'asdasd'; // --> $ 0.00
  27. Edit2.Text := 'asdasd'; // --> $ 100.00
  28. end;
  29.  
  30. procedure TForm1.Button2Click(Sender: TObject);
  31. begin
  32. Edit1.Value := 123.456;
  33. Edit2.Value := 123.45;
  34. end;
  35.  
  36. procedure TForm1.Edit1FormatText(Sender: TObject; const Value: Currency; var Text: string);
  37. begin
  38. Text := CurrToStrF(Value, ffCurrency, 3);
  39. end;
  40.  
  41. procedure TForm1.FormCreate(Sender: TObject);
  42. var
  43. MyFormatSettings: TFormatSettings;
  44. begin
  45. Edit1.OnFormatText := Edit1FormatText;
  46.  
  47. MyFormatSettings := TFormatSettings.Create; // hay mas constructores, revisar la documentacion
  48. MyFormatSettings.CurrencyString := '$'; // cambiar las propiedades deseadas
  49. // cambiar mas propiedades
  50. // asignar
  51. Edit2.FormatSettings := MyFormatSettings;
  52. Edit2.DefaultValue := 100;
  53. end;


  • 1

#3 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.283 mensajes
  • LocationMéxico

Escrito 21 febrero 2017 - 06:06

Si bien aca respondi esta consulta me parece adecuado tambien publicarlo en Delphi Access
 
Puede haber alguna cuestion menor pero en lineas generales me parece un buen punto de partida:


Muy interesante tu propuesta amigo. Se ve que dominas el arte de la Herencia y Polimorfismo :)

 

Saludos (y)


  • 1