home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 31 / CDASC_31_1996_juillet_aout.iso / vrac / del2faq.zip / CURREDIT.ZIP / CURREDIT.PAS next >
Pascal/Delphi Source File  |  1995-03-29  |  4KB  |  168 lines
  1.  
  2. Unit CurrEdit;
  3.  
  4. Interface
  5.  
  6. uses
  7.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  8.   Menus, Forms, Dialogs, StdCtrls;
  9.  
  10. type
  11.   TCurrencyEdit = class(TCustomMemo)
  12.   private
  13.     DispFormat: string;
  14.     FieldValue: Extended;
  15.     procedure SetFormat(A: string);
  16.     procedure SetFieldValue(A: Extended);
  17.     procedure CMEnter(var Message: TCMEnter);           message CM_ENTER;
  18.     procedure CMExit(var Message: TCMExit);             message CM_EXIT;
  19.     procedure FormatText;
  20.     procedure UnFormatText;
  21.   protected
  22.     procedure KeyPress(var Key: Char); override;
  23.     procedure CreateParams(var Params: TCreateParams); override;
  24.   public
  25.     constructor Create(AOwner: TComponent); override;
  26.   published
  27.     property Alignment default taRightJustify;
  28.     property AutoSize default True;
  29.     property BorderStyle;
  30.  
  31.     property Color;
  32.     property Ctl3D;
  33.     property DisplayFormat: string read DispFormat write SetFormat;
  34.     property DragCursor;
  35.     property DragMode;
  36.     property Enabled;
  37.     property Font;
  38.     property HideSelection;
  39.     property MaxLength;
  40.     property ParentColor;
  41.     property ParentCtl3D;
  42.     property ParentFont;
  43.     property ParentShowHint;
  44.     property PopupMenu;
  45.     property ReadOnly;
  46.     property ShowHint;
  47.     property TabOrder;
  48.     property Value: Extended read FieldValue write SetFieldValue;
  49.     property Visible;
  50.     property OnChange;
  51.  
  52.     property OnClick;
  53.     property OnDblClick;
  54.     property OnDragDrop;
  55.     property OnDragOver;
  56.     property OnEndDrag;
  57.     property OnEnter;
  58.     property OnExit;
  59.     property OnKeyDown;
  60.     property OnKeyPress;
  61.     property OnKeyUp;
  62.     property OnMouseDown;
  63.     property OnMouseMove;
  64.     property OnMouseUp;
  65.   end;
  66.  
  67. procedure Register;
  68.  
  69. implementation
  70.  
  71. procedure Register;
  72. begin
  73.   RegisterComponents('Additional', [TCurrencyEdit]);
  74. end;
  75.  
  76. constructor TCurrencyEdit.Create(AOwner: TComponent);
  77. begin
  78.   inherited Create(AOwner);
  79.   AutoSize := True;
  80.   Alignment := taRightJustify;
  81.   Width := 121;
  82.   Height := 25;
  83.  
  84.   DispFormat := '$,0.00;($,0.00)';
  85.   FieldValue := 0.0;
  86.   AutoSelect := False;
  87.   WantReturns := False;
  88.   WordWrap := False;
  89.   FormatText;
  90. end;
  91.  
  92. procedure TCurrencyEdit.SetFormat(A: String);
  93. begin
  94.   if DispFormat <> A then
  95.     begin
  96.       DispFormat:= A;
  97.       FormatText;
  98.     end;
  99. end;
  100.  
  101. procedure TCurrencyEdit.SetFieldValue(A: Extended);
  102. begin
  103.   if FieldValue <> A then
  104.     begin
  105.       FieldValue := A;
  106.       FormatText;
  107.     end;
  108. end;
  109.  
  110. procedure TCurrencyEdit.UnFormatText;
  111. var
  112.   TmpText : String;
  113.   Tmp     : Byte;
  114.   IsNeg   : Boolean;
  115. begin
  116.   IsNeg := (Pos('-',Text) > 0) or (Pos('(',Text) > 0);
  117.   TmpText := '';
  118.   For Tmp := 1 to Length(Text) do
  119.  
  120.     if Text[Tmp] in ['0'..'9','.'] then
  121.       TmpText := TmpText + Text[Tmp];
  122.   try
  123.     FieldValue := StrToFloat(TmpText);
  124.     if IsNeg then FieldValue := -FieldValue;
  125.   except
  126.     MessageBeep(mb_IconAsterisk);
  127.   end;
  128. end;
  129.  
  130. procedure TCurrencyEdit.FormatText;
  131. begin
  132.   Text := FormatFloat(DispFormat,FieldValue);
  133. end;
  134.  
  135. procedure TCurrencyEdit.CMEnter(var Message: TCMEnter);
  136. begin
  137.   SelectAll;
  138.   inherited;
  139. end;
  140.  
  141. procedure TCurrencyEdit.CMExit(var Message: TCMExit);
  142. begin
  143.   UnformatText;
  144.   FormatText;
  145.   Inherited;
  146. end;
  147.  
  148. procedure TCurrencyEdit.KeyPress(var Key: Char);
  149. begin
  150.   if Not (Key in ['0'..'9','.','-']) Then Key := #0;
  151.   inherited KeyPress(Key);
  152. end;
  153.  
  154. procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);
  155.  
  156. begin
  157.   inherited CreateParams(Params);
  158.   case Alignment of
  159.     taLeftJustify  : Params.Style := Params.Style or ES_LEFT and Not ES_MULTILINE;
  160.     taRightJustify : Params.Style := Params.Style or ES_RIGHT and Not ES_MULTILINE;
  161.     taCenter       : Params.Style := Params.Style or ES_CENTER and Not ES_MULTILINE;
  162.   end;
  163. end;
  164.  
  165. End.
  166.  
  167.  
  168.