unit CurrEdit;
interface
uses
SysUtils,
WinTypes,
WinProcs,
Messages,
Classes,
Graphics,
Controls,
Menus,
Forms,
Dialogs,
StdCtrls;
type
TCurrencyEdit = class(TCustomMemo)
private
DispFormat: string;
FieldValue: Extended;
procedure SetFormat(A: string);
procedure SetFieldValue(A: Extended);
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure FormatText;
procedure UnFormatText;
protected
procedure KeyPress(var Key: Char); override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
published
property Alignment default taRightJustify;
property AutoSize default True;
property BorderStyle;
property Color;
property Ctl3D;
property DisplayFormat: string read DispFormat write SetFormat;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property MaxLength;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property Value: Extended read FieldValue write SetFieldValue;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Additional', [TCurrencyEdit]);
end;
constructor TCurrencyEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoSize := True;
Alignment := taRightJustify;
Width := 121;
Height := 25;
DispFormat := '$,0.00;($,0.00)';
FieldValue := 0.0;
AutoSelect := False;
WantReturns := False;
WordWrap := False;
FormatText;
end;
procedure TCurrencyEdit.SetFormat(A: string);
begin
if DispFormat <> A then
begin
DispFormat := A;
FormatText;
end;
end;
procedure TCurrencyEdit.SetFieldValue(A: Extended);
begin
if FieldValue <> A then
begin
FieldValue := A;
FormatText;
end;
end;
procedure TCurrencyEdit.UnFormatText;
var
TmpText: string;
Tmp: Byte;
IsNeg: Boolean;
begin
IsNeg := (Pos('-', Text) > 0) or (Pos('(', Text) > 0);
TmpText := '';
for Tmp := 1 to Length(Text) do
if Text[Tmp] in ['0'..'9', '.'] then
TmpText := TmpText + Text[Tmp];
try
FieldValue := StrToFloat(TmpText);
if IsNeg then
FieldValue := -FieldValue;
except
MessageBeep(mb_IconAsterisk);
end;
end;
procedure TCurrencyEdit.FormatText;
begin
Text := FormatFloat(DispFormat, FieldValue);
end;
procedure TCurrencyEdit.CMEnter(var Message: TCMEnter);
begin
SelectAll;
inherited;
end;
procedure TCurrencyEdit.CMExit(var Message: TCMExit);
begin
UnformatText;
FormatText;
inherited;
end;
procedure TCurrencyEdit.KeyPress(var Key: Char);
begin
if not (Key in ['0'..'9', '.', '-']) then
Key := #0;
inherited KeyPress(Key);
end;
procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
case Alignment of
taLeftJustify: Params.Style := Params.Style or ES_LEFT and not ES_MULTILINE;
taRightJustify: Params.Style := Params.Style or ES_RIGHT and not
ES_MULTILINE;
taCenter: Params.Style := Params.Style or ES_CENTER and not ES_MULTILINE;
end;
end;
end.
|
Денежное поле редактирования
