[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]