Денежное поле редактирования
unit CurrEdit; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Menus, Forms, Dialogs, StdCtrls; type TCurrencyEdit = class(TCustomMemo) private DispFormat: string; FieldValue: Extended; procedure SetFormat(A: string); procedure SetFieldValue(A: Extended); 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 DisplayFormat: string read DispFormat write SetFormat; property DragCursor; property DragMode; property Enabled; property Font; property HideSelection; property MaxLength; property ParentColor; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; 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 := True; Alignment := taRightJustify; Width := 121; Height := 25; DispFormat := '$,0.00;($,0.00)'; FieldValue := 0.0; 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.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','.'] then TmpText := TmpText + Text[Tmp]; try FieldValue := StrToFloat(TmpText); if IsNeg then FieldValue := -FieldValue; except MessageBeep(mb_IconAsterisk); end; end; procedure TCurrencyEdit.FormatText; begin Text := FormatFloat(DispFormat,FieldValue); 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); begin if Not (Key in ['0'..'9','.','-']) Then Key := #0; inherited KeyPress(Key); end; procedure TCurrencyEdit.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); case Alignment of taLeftJustify : Params.Style := Params.Style or ES_LEFT and Not ES_MULTILINE; taRightJustify : Params.Style := Params.Style or ES_RIGHT and Not ES_MULTILINE; taCenter : Params.Style := Params.Style or ES_CENTER and Not ES_MULTILINE; end; end; end. |
[001164]