You've already forked lazarus-ccr
Added: TJCurrencyEdit, TJLabeledCurrencyEdit
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1976 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jujibo
@ -6,6 +6,7 @@ JUJIBOUTILS
|
|||||||
Version pre-1.0
|
Version pre-1.0
|
||||||
--------------------------------------------------
|
--------------------------------------------------
|
||||||
2011-09-20 Added: TJIntegerEdit, TJLabeledIntegerEdit
|
2011-09-20 Added: TJIntegerEdit, TJLabeledIntegerEdit
|
||||||
|
TJCurrencyEdit, TJLabeledCurrencyEdit
|
||||||
2011-09-19 Added: TJDBLabeledIntegerEdit, TJDBLabeledCurrencyEdit, TJDBLabeledDateEdit
|
2011-09-19 Added: TJDBLabeledIntegerEdit, TJDBLabeledCurrencyEdit, TJDBLabeledDateEdit
|
||||||
2011-09-19 First package: TJDBIntegerEdit, TJDBCurrencyEdit, TJDBDateEdit and example
|
2011-09-19 First package: TJDBIntegerEdit, TJDBCurrencyEdit, TJDBDateEdit and example
|
||||||
2011-09-14 Add Non Database input controls example
|
2011-09-14 Add Non Database input controls example
|
||||||
|
|||||||
@ -12,7 +12,7 @@
|
|||||||
<CompilerPath Value="$(CompPath)"/>
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
</Other>
|
</Other>
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Files Count="9">
|
<Files Count="11">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="src/jdbcurrencyedit.pas"/>
|
<Filename Value="src/jdbcurrencyedit.pas"/>
|
||||||
<HasRegisterProc Value="True"/>
|
<HasRegisterProc Value="True"/>
|
||||||
@ -57,6 +57,16 @@
|
|||||||
<HasRegisterProc Value="True"/>
|
<HasRegisterProc Value="True"/>
|
||||||
<UnitName Value="JLabeledIntegerEdit"/>
|
<UnitName Value="JLabeledIntegerEdit"/>
|
||||||
</Item9>
|
</Item9>
|
||||||
|
<Item10>
|
||||||
|
<Filename Value="src/jcurrencyedit.pas"/>
|
||||||
|
<HasRegisterProc Value="True"/>
|
||||||
|
<UnitName Value="JCurrencyEdit"/>
|
||||||
|
</Item10>
|
||||||
|
<Item11>
|
||||||
|
<Filename Value="src/jlabeledcurrencyedit.pas"/>
|
||||||
|
<HasRegisterProc Value="True"/>
|
||||||
|
<UnitName Value="JLabeledCurrencyEdit"/>
|
||||||
|
</Item11>
|
||||||
</Files>
|
</Files>
|
||||||
<Type Value="RunAndDesignTime"/>
|
<Type Value="RunAndDesignTime"/>
|
||||||
<RequiredPkgs Count="2">
|
<RequiredPkgs Count="2">
|
||||||
|
|||||||
@ -9,7 +9,8 @@ interface
|
|||||||
uses
|
uses
|
||||||
jdbcurrencyedit, jdbdateedit, jdbintegeredit, jcontrolutils,
|
jdbcurrencyedit, jdbdateedit, jdbintegeredit, jcontrolutils,
|
||||||
jdblabeledcurrencyedit, jdblabeleddateedit, jdblabeledintegeredit,
|
jdblabeledcurrencyedit, jdblabeleddateedit, jdblabeledintegeredit,
|
||||||
JIntegerEdit, JLabeledIntegerEdit, LazarusPackageIntf;
|
JIntegerEdit, JLabeledIntegerEdit, JCurrencyEdit, JLabeledCurrencyEdit,
|
||||||
|
LazarusPackageIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
@ -23,6 +24,8 @@ begin
|
|||||||
RegisterUnit('jdblabeledintegeredit', @jdblabeledintegeredit.Register);
|
RegisterUnit('jdblabeledintegeredit', @jdblabeledintegeredit.Register);
|
||||||
RegisterUnit('JIntegerEdit', @JIntegerEdit.Register);
|
RegisterUnit('JIntegerEdit', @JIntegerEdit.Register);
|
||||||
RegisterUnit('JLabeledIntegerEdit', @JLabeledIntegerEdit.Register);
|
RegisterUnit('JLabeledIntegerEdit', @JLabeledIntegerEdit.Register);
|
||||||
|
RegisterUnit('JCurrencyEdit', @JCurrencyEdit.Register);
|
||||||
|
RegisterUnit('JLabeledCurrencyEdit', @JLabeledCurrencyEdit.Register);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
|
|||||||
212
components/jujiboutils/jujibo-utils/src/jcurrencyedit.pas
Normal file
212
components/jujiboutils/jujibo-utils/src/jcurrencyedit.pas
Normal file
@ -0,0 +1,212 @@
|
|||||||
|
unit JCurrencyEdit;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, StdCtrls, Graphics, Dialogs;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TJCurrencyEdit }
|
||||||
|
|
||||||
|
TJCurrencyEdit = class(TCustomEdit)
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
theValue: currency;
|
||||||
|
fFormat: string;
|
||||||
|
fDecimals: integer;
|
||||||
|
function getDecimals: integer;
|
||||||
|
function getFormat: string;
|
||||||
|
function getValue: currency;
|
||||||
|
procedure formatInput;
|
||||||
|
procedure setDecimals(const AValue: integer);
|
||||||
|
procedure setFormat(const AValue: string);
|
||||||
|
function scaleTo(const AValue: currency; const NDecimals: integer): currency;
|
||||||
|
function IsValidFloat(const Value: string): boolean;
|
||||||
|
procedure setValue(const AValue: currency);
|
||||||
|
protected
|
||||||
|
{ Protected declarations }
|
||||||
|
procedure DoEnter; override;
|
||||||
|
procedure DoExit; override;
|
||||||
|
procedure KeyPress(var Key: char); override;
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
constructor Create(TheOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
published
|
||||||
|
{ Published declarations }
|
||||||
|
property DisplayFormat: string read getFormat write setFormat;
|
||||||
|
property Decimals: integer read getDecimals write setDecimals;
|
||||||
|
property Value: currency read getValue write setValue;
|
||||||
|
|
||||||
|
property Action;
|
||||||
|
property Align;
|
||||||
|
property Alignment;
|
||||||
|
property Anchors;
|
||||||
|
property AutoSize;
|
||||||
|
property AutoSelect;
|
||||||
|
property BidiMode;
|
||||||
|
property BorderStyle;
|
||||||
|
property BorderSpacing;
|
||||||
|
property CharCase;
|
||||||
|
property Color;
|
||||||
|
property Constraints;
|
||||||
|
property DragCursor;
|
||||||
|
property DragKind;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
property HideSelection;
|
||||||
|
property MaxLength;
|
||||||
|
property ParentBidiMode;
|
||||||
|
property OnChange;
|
||||||
|
property OnChangeBounds;
|
||||||
|
property OnClick;
|
||||||
|
property OnContextPopup;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEditingDone;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseEnter;
|
||||||
|
property OnMouseLeave;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnResize;
|
||||||
|
property OnStartDrag;
|
||||||
|
property OnUTF8KeyPress;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property TabStop;
|
||||||
|
property TabOrder;
|
||||||
|
property Visible;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Math;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
{$I jcurrencyedit_icon.lrs}
|
||||||
|
RegisterComponents('Additional', [TJCurrencyEdit]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TJCurrencyEdit }
|
||||||
|
|
||||||
|
function TJCurrencyEdit.getDecimals: integer;
|
||||||
|
begin
|
||||||
|
Result := fDecimals;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJCurrencyEdit.getFormat: string;
|
||||||
|
begin
|
||||||
|
Result := fFormat;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJCurrencyEdit.getValue: currency;
|
||||||
|
begin
|
||||||
|
Result := theValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJCurrencyEdit.formatInput;
|
||||||
|
begin
|
||||||
|
Caption := FormatFloat(DisplayFormat, theValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJCurrencyEdit.setDecimals(const AValue: integer);
|
||||||
|
begin
|
||||||
|
if (AValue >= 0) and (AValue < 5) then
|
||||||
|
fDecimals := AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJCurrencyEdit.setFormat(const AValue: string);
|
||||||
|
begin
|
||||||
|
fFormat := AValue;
|
||||||
|
formatInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJCurrencyEdit.scaleTo(const AValue: currency;
|
||||||
|
const NDecimals: integer): currency;
|
||||||
|
begin
|
||||||
|
Result := round(AValue * power(10, NDecimals)) / power(10, NDecimals);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJCurrencyEdit.IsValidFloat(const Value: string): boolean;
|
||||||
|
begin
|
||||||
|
if StrToCurrDef(Value, MaxCurrency) = MaxCurrency then
|
||||||
|
Result := False
|
||||||
|
else
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJCurrencyEdit.setValue(const AValue: currency);
|
||||||
|
begin
|
||||||
|
theValue := scaleTo(AValue, fDecimals);
|
||||||
|
formatInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJCurrencyEdit.DoEnter;
|
||||||
|
begin
|
||||||
|
inherited DoEnter;
|
||||||
|
Text := FloatToStr(theValue);
|
||||||
|
SelectAll;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJCurrencyEdit.DoExit;
|
||||||
|
begin
|
||||||
|
inherited DoExit;
|
||||||
|
if IsValidFloat(Text) then
|
||||||
|
theValue := StrToCurr(Text)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ShowMessage(Text + ' no es un valor válido');
|
||||||
|
SetFocus;
|
||||||
|
end;
|
||||||
|
theValue := scaleTo(theValue, fDecimals);
|
||||||
|
formatInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJCurrencyEdit.KeyPress(var Key: char);
|
||||||
|
begin
|
||||||
|
if (Key in ['.', ',']) then
|
||||||
|
Key := Decimalseparator;
|
||||||
|
if (key = DecimalSeparator) and (Pos(key, Text) > 0) then
|
||||||
|
key := #0;
|
||||||
|
if not (Key in ['0'..'9', DecimalSeparator, '+', '-', #8, #9]) then
|
||||||
|
Key := #0;
|
||||||
|
if (Key = DecimalSeparator) and (fDecimals = 0) then
|
||||||
|
Key := #0;
|
||||||
|
inherited KeyPress(Key);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJCurrencyEdit.Create(TheOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(TheOwner);
|
||||||
|
Text := '';
|
||||||
|
fFormat := '#,0.00';
|
||||||
|
fDecimals := 2;
|
||||||
|
formatInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJCurrencyEdit.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
@ -0,0 +1,29 @@
|
|||||||
|
LazarusResources.Add('tjcurrencyedit','PNG',[
|
||||||
|
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||||
|
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147
|
||||||
|
+#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#219#9#20#9
|
||||||
|
+#27#2'.'#175'u'#204#0#0#2'''IDATH'#199#213#148'?h'#19'q'#20#199'?'#215#166
|
||||||
|
+#181#144#208#218'@'#29#132'f'#8#136'A'#172#29'r'#160#18'p'#136#171#139#163'v'
|
||||||
|
+'p'#168'.'#191#12#226#146#14#130'tq'#136#131'Z'#240'N'#161'D'#232#224#159'U'
|
||||||
|
+#208'1'#29'4'#193'%S'#20','#4#170#182'('#18'!MJ'#2'Il'#242'sh'#239#252#221']'
|
||||||
|
+#26#154'T'#7#31#252#184#247#30#191#251'~~'#239#221#187#31#252'c'#211#212#224
|
||||||
|
+#197#219#239','#191'^'#239#186#241#198#165'0W.'#28#31#12#160#10'/%f9'#29#10
|
||||||
|
+#240'q'#163'F'#169#210#164'TmQ'#170'4y'#149#253'6'#16'h'#24'`k'#234'2gN'#4'9'
|
||||||
|
+'w*'#136#127'l'#152'z'#179#227#16'/U['#4''''#198#240#251'G'#200#228#127#240
|
||||||
|
+'9'#247#244#192#0#31'@xz'#156'B'#177'L'#161#8#199#142#134#1#28#226#245'F'#155
|
||||||
|
+'B'#177#140#181'w'#181#143#22#249',''R{.'#1#222#189#132#181#192'Um'#245'^'
|
||||||
|
+#140'x2go<?3E'#189#209#166#214#216#233#235#27#248#0'F?='#145#134'a'#218#201
|
||||||
|
+'D'#2#185#244'u'#150'R%'#162#169#149#0#172'on'#247#5#24#18'B8'#196#1#12#195
|
||||||
|
+#228'qj'#193#145'{'#255#225''''#133'b'#153#240#244'x'#255#21'$'#18#2'g'#5#2
|
||||||
|
+#128#187#207#214#254'N'#139#12#195#180'E'#213#248#246'\'#132#195#182#200#167
|
||||||
|
+#138#186#237'K'#254#141#4#8#236'-'#134'`'#230'$'#204#165'W'#14'$>?'#127'M'
|
||||||
|
+#211#132#16#210#13#176#170'92'#210#26#248#138'X\'#188#195#196'dH'#235#217#162
|
||||||
|
+#251#15#151#7#6'lW6w'#29'!'#132#148#18#207#218#205'K'#25'Of'#165'j'#241'd'
|
||||||
|
+#214#206#253#218'i;'#226'h4j?'#171'['#27#210#6#184'!'#127'r^'#128#10#234't:'
|
||||||
|
+#142'X'#133'X'#128#158'-'#234'fRJ4Ms'#196#3'O'#209'~'#194#23#23'rdR1'#219#7
|
||||||
|
+#236#216#243''''#171'S'#227#158'"'#199#189#190''''#238'>}&'#21'#'#147#138#217
|
||||||
|
+' O'#5#166'ijB'#8#233#22'}'#240#200#232#250#130'zz'#21#182#239']'#4#16#141
|
||||||
|
+#158#245#136#143'j^a'#213#183'b'#203#207#164'b'#232#186'N>'#159'G'#215#245
|
||||||
|
+#222#212'tzE'#222#186'y'#221'35'#253#152'5E]k'#180'g'#248#144'61'#25#210#248
|
||||||
|
+#239#237'7T'#213#192'u'#139'\'#209'^'#0#0#0#0'IEND'#174'B`'#130
|
||||||
|
]);
|
||||||
@ -35,6 +35,57 @@ type
|
|||||||
{ Published declarations }
|
{ Published declarations }
|
||||||
property DisplayFormat: string read getFormat write setFormat;
|
property DisplayFormat: string read getFormat write setFormat;
|
||||||
property Value: integer read getValue write setValue;
|
property Value: integer read getValue write setValue;
|
||||||
|
|
||||||
|
property Action;
|
||||||
|
property Align;
|
||||||
|
property Alignment;
|
||||||
|
property Anchors;
|
||||||
|
property AutoSize;
|
||||||
|
property AutoSelect;
|
||||||
|
property BidiMode;
|
||||||
|
property BorderStyle;
|
||||||
|
property BorderSpacing;
|
||||||
|
property CharCase;
|
||||||
|
property Color;
|
||||||
|
property Constraints;
|
||||||
|
property DragCursor;
|
||||||
|
property DragKind;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
property HideSelection;
|
||||||
|
property MaxLength;
|
||||||
|
property ParentBidiMode;
|
||||||
|
property OnChange;
|
||||||
|
property OnChangeBounds;
|
||||||
|
property OnClick;
|
||||||
|
property OnContextPopup;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEditingDone;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseEnter;
|
||||||
|
property OnMouseLeave;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnResize;
|
||||||
|
property OnStartDrag;
|
||||||
|
property OnUTF8KeyPress;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property TabStop;
|
||||||
|
property TabOrder;
|
||||||
|
property Visible;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
|
|||||||
208
components/jujiboutils/jujibo-utils/src/jlabeledcurrencyedit.pas
Normal file
208
components/jujiboutils/jujibo-utils/src/jlabeledcurrencyedit.pas
Normal file
@ -0,0 +1,208 @@
|
|||||||
|
unit JLabeledCurrencyEdit;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, ExtCtrls, Graphics, Dialogs;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TJLabeledCurrencyEdit }
|
||||||
|
|
||||||
|
TJLabeledCurrencyEdit = class(TCustomLabeledEdit)
|
||||||
|
private
|
||||||
|
theValue: currency;
|
||||||
|
fFormat: string;
|
||||||
|
fDecimals: integer;
|
||||||
|
function getDecimals: integer;
|
||||||
|
function getFormat: string;
|
||||||
|
function getValue: currency;
|
||||||
|
procedure formatInput;
|
||||||
|
procedure setDecimals(const AValue: integer);
|
||||||
|
procedure setFormat(const AValue: string);
|
||||||
|
function scaleTo(const AValue: currency; const NDecimals: integer): currency;
|
||||||
|
function IsValidFloat(const Value: string): boolean;
|
||||||
|
procedure setValue(const AValue: currency);
|
||||||
|
protected
|
||||||
|
{ Protected declarations }
|
||||||
|
procedure DoEnter; override;
|
||||||
|
procedure DoExit; override;
|
||||||
|
procedure KeyPress(var Key: char); override;
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
constructor Create(TheOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
published
|
||||||
|
{ Published declarations }
|
||||||
|
property DisplayFormat: string read getFormat write setFormat;
|
||||||
|
property Decimals: integer read getDecimals write setDecimals;
|
||||||
|
property Value: currency read getValue write setValue;
|
||||||
|
|
||||||
|
property Action;
|
||||||
|
property Align;
|
||||||
|
property Alignment;
|
||||||
|
property Anchors;
|
||||||
|
property AutoSelect;
|
||||||
|
property AutoSize;
|
||||||
|
property BidiMode;
|
||||||
|
property BorderSpacing;
|
||||||
|
property BorderStyle;
|
||||||
|
property CharCase;
|
||||||
|
property Color;
|
||||||
|
property Constraints;
|
||||||
|
property DragCursor;
|
||||||
|
property DragMode;
|
||||||
|
property EditLabel;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
property LabelPosition;
|
||||||
|
property LabelSpacing;
|
||||||
|
property MaxLength;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ReadOnly;
|
||||||
|
property ShowHint;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Visible;
|
||||||
|
property OnChange;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEditingDone;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnStartDrag;
|
||||||
|
property OnUTF8KeyPress;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
uses
|
||||||
|
Math;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
{$I jlabeledcurrencyedit_icon.lrs}
|
||||||
|
RegisterComponents('Additional', [TJLabeledCurrencyEdit]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TJLabeledCurrencyEdit }
|
||||||
|
|
||||||
|
function TJLabeledCurrencyEdit.getDecimals: integer;
|
||||||
|
begin
|
||||||
|
Result := fDecimals;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJLabeledCurrencyEdit.getFormat: string;
|
||||||
|
begin
|
||||||
|
Result := fFormat;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJLabeledCurrencyEdit.getValue: currency;
|
||||||
|
begin
|
||||||
|
Result := theValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJLabeledCurrencyEdit.formatInput;
|
||||||
|
begin
|
||||||
|
Caption := FormatFloat(DisplayFormat, theValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJLabeledCurrencyEdit.setDecimals(const AValue: integer);
|
||||||
|
begin
|
||||||
|
if (AValue >= 0) and (AValue < 5) then
|
||||||
|
fDecimals := AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJLabeledCurrencyEdit.setFormat(const AValue: string);
|
||||||
|
begin
|
||||||
|
fFormat := AValue;
|
||||||
|
formatInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJLabeledCurrencyEdit.scaleTo(const AValue: currency;
|
||||||
|
const NDecimals: integer): currency;
|
||||||
|
begin
|
||||||
|
Result := round(AValue * power(10, NDecimals)) / power(10, NDecimals);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJLabeledCurrencyEdit.IsValidFloat(const Value: string): boolean;
|
||||||
|
begin
|
||||||
|
if StrToCurrDef(Value, MaxCurrency) = MaxCurrency then
|
||||||
|
Result := False
|
||||||
|
else
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJLabeledCurrencyEdit.setValue(const AValue: currency);
|
||||||
|
begin
|
||||||
|
theValue := scaleTo(AValue, fDecimals);
|
||||||
|
formatInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJLabeledCurrencyEdit.DoEnter;
|
||||||
|
begin
|
||||||
|
inherited DoEnter;
|
||||||
|
Text := FloatToStr(theValue);
|
||||||
|
SelectAll;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJLabeledCurrencyEdit.DoExit;
|
||||||
|
begin
|
||||||
|
inherited DoExit;
|
||||||
|
if IsValidFloat(Text) then
|
||||||
|
theValue := StrToCurr(Text)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ShowMessage(Text + ' no es un valor válido');
|
||||||
|
SetFocus;
|
||||||
|
end;
|
||||||
|
theValue := scaleTo(theValue, fDecimals);
|
||||||
|
formatInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJLabeledCurrencyEdit.KeyPress(var Key: char);
|
||||||
|
begin
|
||||||
|
if (Key in ['.', ',']) then
|
||||||
|
Key := Decimalseparator;
|
||||||
|
if (key = DecimalSeparator) and (Pos(key, Text) > 0) then
|
||||||
|
key := #0;
|
||||||
|
if not (Key in ['0'..'9', DecimalSeparator, '+', '-', #8, #9]) then
|
||||||
|
Key := #0;
|
||||||
|
if (Key = DecimalSeparator) and (fDecimals = 0) then
|
||||||
|
Key := #0;
|
||||||
|
inherited KeyPress(Key);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJLabeledCurrencyEdit.Create(TheOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(TheOwner);
|
||||||
|
Text := '';
|
||||||
|
fFormat := '#,0.00';
|
||||||
|
fDecimals := 2;
|
||||||
|
formatInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJLabeledCurrencyEdit.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
@ -0,0 +1,33 @@
|
|||||||
|
LazarusResources.Add('tjlabeledcurrencyedit','PNG',[
|
||||||
|
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||||
|
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147
|
||||||
|
+#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#219#9#20#9
|
||||||
|
+#28#0#143#224#130''''#0#0#2'sIDATH'#199#213'U=hSQ'#24'='#183#212#186#148#134
|
||||||
|
+'vT'#218'!P\'#180'"'#247#161'C'#162'C3t'#17#28#204#162#14#218#31'Qn'#134#224
|
||||||
|
+#146#146'E'#170'KH'#7'5h'#162#16#130#173#14']'#178'T'#234#248':'#148'8'#4#242
|
||||||
|
+'(DQ'#161'P'#181#210'"'#25'j'#162'-'#164#177#201#215#197'{'#185#239#229'%'
|
||||||
|
+#212#136#131#7#30#249#190'Kr'#206#249#206#251#222#11#240#143#193#244'fae'#11
|
||||||
|
+#233#165'u'#215'/'#222#188#232#197#149#11#199':'#19#208#137#19#161#211'89'
|
||||||
|
+#212#139'w'#27';('#149#247'P'#170#212'P*'#239'a1'#183#217#145'P'#23#0#164#151
|
||||||
|
+#214'12<'#128'K'#254#227'('#149#247#20'ydb'#140#164#200#200#240#0#188#131'}-'
|
||||||
|
+''''#148#224#156'S'#147#128'w'#176#15#197#181'm,'#230'6'#149#227#200#196#24#1
|
||||||
|
+#192#139'{A'#218#173#214#225#239#127'O'#171's'#227'T1'#195#148#205'f'#201'I'
|
||||||
|
+#198'9'''#217#235#231#12#0#166#30#23#209#243#225#153':'#252#216'{'#149'-'#207
|
||||||
|
+#250#192#185'A'#158'@'#130#1'@'#197#12#211#249#219'/'#217'Nu'#31#171's'#227
|
||||||
|
+'dY'#22#203'f'#179#20#139#197#0#0#209'h'#20#193'`'#144'q'#206#201#178','#219
|
||||||
|
+#189#133#16#130#136#160'.!'#4#189#253#242#19#156'sZX'#217'B'#226#213''''#229
|
||||||
|
+'Pw'#234't'#238#26#145#16#130#146#201#148'M0'#153'L'#225'i|'#154#156#249'z'#2
|
||||||
|
+#9'v'#230#198's&'#29#202#168#156#181'm'#139#132#16'$I%B!'#1#0#200#231#243#138
|
||||||
|
+'X'#156#253#166#226#0#0#203#178'lq'#200'ZN '#207#153#156'@'#146'J'#177'PH'
|
||||||
|
+#224#242#173#251'L'#222#244'R'#165#134#221'j'#29#197#181'm,'#207#250#15#189
|
||||||
|
+#166#221':'#169#19#159#11#175#9#0'z'#127'_'#232#2'N'#157#0#174'e'#230#15'E>9'
|
||||||
|
+'y'#157#181#141#232#232#145'Z'#199#175#136#153#153#187#240#244#15#177'n='#18
|
||||||
|
+'gD'#15#30#165';'#22#248'Q'#254#234#190#162#250#170#18#17#141'Fr'#164'c4'#146
|
||||||
|
+'Sg'#191#246#235#182#158's'#174'>+'#223'7H'#9#184'='#7#173#4't'#161'F'#163'a'
|
||||||
|
+#235'u'#17')'#208'6"7'#16#17#24'c'#182#190#227'-jE'#28#152'~'#3'3'#238'S5'#0
|
||||||
|
+#213#187#190'M'#157'n'#221#220'Kr'#167'{3'#238#131#25#247')'#161#166#9'R'#169
|
||||||
|
+#20#19'B'#144#147#244#225#147#164#235#15't'#247#186'X'#219#255#3#206#207'5'
|
||||||
|
+#145#247#176'fb'#189#150#189#172#205#184#15#134'a'#160'P('#192'0'#140#246#170
|
||||||
|
+#153#204'<'#221#9'O5m'#205#159'@n'#145#235#140'j'#135#255#18#158#254'!'#134
|
||||||
|
+#255#30#7'b'#5#12#188'T'#130#161';'#0#0#0#0'IEND'#174'B`'#130
|
||||||
|
]);
|
||||||
@ -35,6 +35,53 @@ type
|
|||||||
{ Published declarations }
|
{ Published declarations }
|
||||||
property DisplayFormat: string read getFormat write setFormat;
|
property DisplayFormat: string read getFormat write setFormat;
|
||||||
property Value: integer read getValue write setValue;
|
property Value: integer read getValue write setValue;
|
||||||
|
|
||||||
|
property Action;
|
||||||
|
property Align;
|
||||||
|
property Alignment;
|
||||||
|
property Anchors;
|
||||||
|
property AutoSelect;
|
||||||
|
property AutoSize;
|
||||||
|
property BidiMode;
|
||||||
|
property BorderSpacing;
|
||||||
|
property BorderStyle;
|
||||||
|
property CharCase;
|
||||||
|
property Color;
|
||||||
|
property Constraints;
|
||||||
|
property DragCursor;
|
||||||
|
property DragMode;
|
||||||
|
property EditLabel;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
property LabelPosition;
|
||||||
|
property LabelSpacing;
|
||||||
|
property MaxLength;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ReadOnly;
|
||||||
|
property ShowHint;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Visible;
|
||||||
|
property OnChange;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEditingDone;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnStartDrag;
|
||||||
|
property OnUTF8KeyPress;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
|
|||||||
Reference in New Issue
Block a user