这有个现成的：
{
最后修改于2002年4月24日。
用于输入Currency数据的Edit控件, 添加了以下属性:
Currency: 用于读取/设定Edit控件的Currency数据.
InputErrorMessage: 当输入错误时MessageBox的提示信息.
InputErrorTitle: 当输入错误时MessageBox的标题.
Limited: 是否设置输入Currency的下限和下限.
LowerLimit: 输入Currency的下限.
UpperLimit: 输入Currency的上限.
NumberOfDigits: 指定小数位数.
OverflowErrorMessage: 当输入超出LowerLimit或UpperLimit的限制时MessageBox的提示信息.
OverflowErrorTitle: 当输入超出LowerLimit或UpperLimit的限制时MessageBox的标题.
Prefix: 用于指定Currency的前缀(比如:'＄: '或'￥: ').
Suffix: 用于指定Currency的后缀(比如:'％').
}
unit CurrencyEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics, Forms;
type
TCurrencyEdit = class(TCustomEdit)
private
{ Private declarations }
FCurrency: Currency;
FInputErrorMessage: String;
FInputErrorTitle: String;
FLimited: Boolean;
FLowerLimit: Currency;
FNumberOfDigits: Integer;
FOverflowErrorMessage: String;
FOverflowErrorTitle: String;
FPrefix: String;
FSuffix: String;
FUpperLimit: Currency;
procedure ErrorMessageBox(const ErrorTitle, ErrorMessage: String);
function VStrCopy(const S: String; BeginIndex, EndIndex: Integer): String;
protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams); override;
procedure DoExit; override;
procedure SetCurrency(Value: Currency); virtual;
procedure SetLimited(Value: Boolean); virtual;
procedure SetLowerLimit(Value: Currency); virtual;
procedure SetNumberOfDigits(Value: Integer); virtual;
procedure SetPrefix(Value: String); virtual;
procedure SetSuffix(Value: String); virtual;
procedure SetUpperLimit(Value: Currency); virtual;
property CharCase;
property MaxLength;
property PasswordChar;
property Text;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
property Anchors;
property AutoSelect;
property AutoSize;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property Color;
property Constraints;
property Ctl3D;
property Currency: Currency read FCurrency write SetCurrency;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property InputErrorMessage: String read FInputErrorMessage write FInputErrorMessage;
property InputErrorTitle: String read FInputErrorTitle write FInputErrorTitle;
property Limited: Boolean read FLimited write SetLimited;
property LowerLimit: Currency read FLowerLimit write SetLowerLimit;
property NumberOfDigits: Integer read FNumberOfDigits write SetNumberOfDigits;
property OEMConvert;
property OverflowErrorMessage: String read FOverflowErrorMessage write FOverflowErrorMessage;
property OverflowErrorTitle: String read FOverflowErrorTitle write FOverflowErrorTitle;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property Prefix: String read FPrefix write SetPrefix;
property ReadOnly;
property ShowHint;
property Suffix: String read FSuffix write SetSuffix;
property TabOrder;
property TabStop;
property Visible;
property UpperLimit: Currency read FUpperLimit write SetUpperLimit;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
type
ECurrencyEditError = class(Exception);
procedure Register;
begin
RegisterComponents('Standard', [TCurrencyEdit]);
end;
{ TCurrencyEdit }
constructor TCurrencyEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Currency := 0;
InputErrorMessage := 'Invalid Data Type.';
InputErrorTitle := 'Input Error:';
Limited := False;
LowerLimit := 0;
NumberOfDigits := 0;
OverflowErrorMessage := 'Out Of Range.';
OverflowErrorTitle := 'Input Error:';
Prefix := '';
Suffix := '';
UpperLimit := 0;
end;
procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_RIGHT;
end;
procedure TCurrencyEdit.DoExit;
var
Index: Integer;
TempExtended: Extended;
begin
if VStrCopy(Text, 1, Length(Prefix)) = Prefix then
Text := VStrCopy(Text, Length(Prefix) + 1, Length(Text));
if VStrCopy(Text, Length(Text) - Length(Suffix) + 1, Length(Text)) = Suffix then
Text := VStrCopy(Text, 1, Length(Text) - Length(Suffix));
for Index := 1 to Length(Text) do
if Text[Index] = ',' then Text := VStrCopy(Text, 1, Index - 1) + VStrCopy(Text, Index + 1, Length(Text));
if not TextToFloat(PChar(Text), TempExtended, fvExtended) then
begin
ErrorMessageBox(InputErrorTitle, InputErrorMessage);
Exit;
end;
if Limited then
if (TempExtended < LowerLimit) or (TempExtended > UpperLimit) then
begin
ErrorMessageBox(OverflowErrorTitle, OverflowErrorMessage);
Exit;
end;
Currency := TempExtended;
inherited DoExit;
end;
procedure TCurrencyEdit.ErrorMessageBox(const ErrorTitle, ErrorMessage: String);
var
TempColor: TColor;
TempString: String;
begin
TempColor := Font.Color;
Font.Color := clRed;
Application.MessageBox(PChar(ErrorMessage), PChar(ErrorTitle), MB_ICONINFORMATION);
Font.Color := TempColor;
TempString := Text;
SetFocus;
Text := TempString;
SelectAll;
end;
procedure TCurrencyEdit.SetCurrency(Value: Currency);
begin
FCurrency := Value;
Text := Prefix + CurrToStrF(FCurrency, ffNumber, NumberOfDigits) + Suffix;
end;
procedure TCurrencyEdit.SetLimited(Value: Boolean);
begin
FLimited := Value;
Currency := FCurrency;
end;
procedure TCurrencyEdit.SetLowerLimit(Value: Currency);
begin
FLowerLimit := Value;
Currency := FCurrency;
end;
procedure TCurrencyEdit.SetNumberOfDigits(Value: Integer);
begin
FNumberOfDigits := Value;
Currency := FCurrency;
end;
procedure TCurrencyEdit.SetPrefix(Value: String);
begin
FPrefix := Value;
Currency := FCurrency;
end;
procedure TCurrencyEdit.SetSuffix(Value: String);
begin
FSuffix := Value;
Currency := FCurrency;
end;
procedure TCurrencyEdit.SetUpperLimit(Value: Currency);
begin
FUpperLimit := Value;
Currency := FCurrency;
end;
function TCurrencyEdit.VStrCopy(const S: String; BeginIndex, EndIndex: Integer): String;
begin
Result := Copy(S, BeginIndex, EndIndex - BeginIndex + 1);
end;
end.
