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.