[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]
unit CurrEdit;
(**************************************************************************
This is my first custom control, so please be merciful. I needed a simple
currency edit field, so below is my attempt. It has pretty good behavior
and I have posted it up to encourage others to share their code as well.
Essentially, the CurrencyEdit field is a modified memo field. I have put
in keyboard restrictions, so the user cannot enter invalid characters.
When the user leaves the field, the number is reformatted to display
appropriately. You can left-, center-, or right-justify the field, and
you can also specify its display format - see the FormatFloat command.
The field value is stored in a property called Value so you should read
and write to that in your program. This field is of type Extended.
If you like this control you can feel free to use it, however, if you
modify it, I would like you to send me whatever you did to it. If you
send me your CIS ID, I will send you copies of my custom controls that
I develop in the future. Please feel free to send me anything you are
working on as well. Perhaps we can spark ideas!
Robert Vivrette, Owner
Prime Time Programming
PO Box 5018
Walnut Creek, CA 94596-1018
Fax: (510) 939-3775
CIS: 76416,1373
Net: RobertV@ix.netcom.com
Thanks to Massimo Ottavini, Thorsten Suhr, Bob Osborn, Mark Erbaugh, Ralf
Gosch, Julian Zagorodnev, and Grant R. Boggs for their enhancements!
Please look for this and other components in the "Unofficial Newsletter of
Delphi Users" posted on the Borland Delphi forum on Compuserve (GO DELPHI)
in the "Delphi IDE" file section.
**************************************************************************)
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Menus, Forms, Dialogs, StdCtrls;
type
TCurrencyEdit = class(TCustomMemo)
private
DispFormat: string;
FieldValue: Extended;
FDecimalPlaces : Word;
FPosColor : TColor;
FNegColor : TColor;
procedure SetFormat(A: string);
procedure SetFieldValue(A: Extended);
procedure SetDecimalPlaces(A: Word);
procedure SetPosColor(A: TColor);
procedure SetNegColor(A: TColor);
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 DecimalPlaces: Word read FDecimalPlaces write SetDecimalPlaces default 2;
property DisplayFormat: string read DispFormat write SetFormat;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property MaxLength;
property NegColor: TColor read FNegColor write SetNegColor default clRed;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property PosColor: TColor read FPosColor write SetPosColor default clBlack;
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 := False;
Alignment := taRightJustify;
Width := 121;
Height := 25;
DispFormat := '$,0.00;($,0.00)';
FieldValue := 0.0;
FDecimalPlaces := 2;
FPosColor := Font.Color;
FNegColor := clRed;
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.SetDecimalPlaces(A: Word);
begin
if DecimalPlaces <> A then
begin
DecimalPlaces := A;
FormatText;
end;
end;
procedure TCurrencyEdit.SetPosColor(A: TColor);
begin
if FPosColor <> A then
begin
FPosColor := A;
FormatText;
end;
end;
procedure TCurrencyEdit.SetNegColor(A: TColor);
begin
if FNegColor <> A then
begin
FNegColor := 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',DecimalSeparator] then
TmpText := TmpText + Text[Tmp];
try
If TmpText='' Then TmpText := '0.00';
FieldValue := StrToFloat(TmpText);
if IsNeg then FieldValue := -FieldValue;
except
MessageBeep(mb_IconAsterisk);
end;
end;
procedure TCurrencyEdit.FormatText;
begin
Text := FormatFloat(DispFormat,FieldValue);
if FieldValue < 0 then
Font.Color := NegColor
else
Font.Color := PosColor;
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);
Var
S : String;
frmParent : TForm;
btnDefault : TButton;
i : integer;
wID : Word;
LParam : LongRec;
begin
{#8 is for Del and Backspace keys.}
if Not (Key in ['0'..'9','.','-', #8, #13]) Then Key := #0;
case Key of
#13 : begin
frmParent := GetParentForm(Self);
UnformatText;
{find default button on the parent form if any}
btnDefault := nil;
for i := 0 to frmParent.ControlCount -1 do
if frmParent.Controls[i] is TButton then
if (frmParent.Controls[i] as TButton).Default then
btnDefault := (frmParent.Controls[i] as TButton);
{if there's a default button, then make the parent form think it was pressed}
if btnDefault <> nil then
begin
wID := GetWindowWord(btnDefault.Handle, GWW_ID);
LParam.Lo := btnDefault.Handle;
LParam.Hi := BN_CLICKED;
SendMessage(frmParent.Handle, WM_COMMAND, wID, longint(LParam) );
end;
Key := #0;
end;
{ allow only one dot in the number }
'.' : if ( Pos('.',Text) >0 ) then Key := #0;
{ allow only one '-' in the number and only in the first position: }
'-' : if ( Pos('-',Text) >0 ) or ( SelStart > 0 ) then Key := #0;
else
{ make sure no other character appears before the '-' }
if ( Pos('-',Text) >0 ) and ( SelStart = 0 ) and (SelLength=0) then Key := #0;
end;
if Key <> Char(vk_Back) then
begin
{S is a model of Text if we accept the keystroke. Use SelStart and
SelLength to find the cursor (insert) position.}
S := Copy(Text,1,SelStart)+Key+Copy(Text,SelStart+SelLength+1,Length(Text));
if ((Pos(DecimalSeparator, S) > 0) and
(Length(S) - Pos(DecimalSeparator, S) > FDecimalPlaces)) {too many decimal places}
or ((Key = '-') and (Pos('-', Text) <> 0)) {only one minus...}
or (Pos('-', S) > 1) {... and only at beginning}
then Key := #0;
end;
if Key <> #0 then inherited KeyPress(Key);
end;
procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);
var
lStyle : longint;
begin
inherited CreateParams(Params);
case Alignment of
taLeftJustify : lStyle := ES_LEFT;
taRightJustify : lStyle := ES_RIGHT;
taCenter : lStyle := ES_CENTER;
end;
Params.Style := Params.Style or lStyle;
end;
end.
[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]