wnnumberedit.pas

一个处理数字的Edit的组件

{**********************************************************
*  编辑框1.01 for  DELPHI (所有版本)                      *
*  NumberEditor system for DELPHI (All ver)               *
*  原创：王锐 (武稀松wr960204)                            *
***********************************************************}
unit WNNumberEdit;

interface

uses
	 Windows, Messages, SysUtils, extctrls, Classes, Graphics, Controls, Forms, Dialogs,
	 StdCtrls, Consts, Math, clipbrd;

const
	 FloatMaxLength =18;
	 BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
type
	 TWNNumberEdit = class;
	 TWNCurrencyEdit = class;
	 TWNNumberEdit = class(TCustomEdit)
	 private
			{ Private-Deklarationen }
			FAutoFormat: Boolean;
			FDigits: byte;
			FMin, FMax: extended;
			fdec: char;
			Fertext: string;
			foldval: extended;
			procedure setvalue(Value: extended);
			procedure setmin(Value: extended);
			procedure setmax(Value: extended);
			procedure SetAutoFormat(Value: Boolean);
			procedure setdigits(Value: byte);
			function getvalue: extended;
			procedure CheckPaste(var msg: tmessage); message WM_PASTE;
	 protected
			{ Protected-Deklarationen }

			procedure KeyPress(var Key: Char); override;
			procedure doexit; override;
			procedure doEnter; override;
	 public
			{ Public-Deklarationen }
			isNullC:Boolean;
			constructor create(aowner: TComponent); override;
			destructor Destroy; override;
	 published
			{ Published-Deklarationen }
      property text;
			property Align;
			property BorderStyle;
			property Color;
			property Ctl3D;
			property Font;
			property HideSelection;
			property ReadOnly;
			property ShowHint;
			property TabOrder;
			property Visible;
			property AutoFormat: Boolean read FAutoFormat write SetAutoFormat;
			property Digits: byte read FDigits write setDigits;
			property Value: extended read getvalue write setValue;
			property Min: extended read Fmin write setMin;
			property Max: extended read Fmax write setmax;
			property ErrorMessage: string read fertext write fertext;
			property OnEnter;
			property OnExit;
			property OnChange;
			property OnClick;
			property OnContextPopup;
			property OnDblClick;
			property OnDragDrop;
			property OnDragOver;
			property OnEndDock;
			property OnEndDrag;
			property OnMouseDown;
			property OnMouseMove;
			property OnMouseUp;
			property OnStartDock;
			property OnStartDrag;

	 end;

	 TWNCurrencyEdit = class(TCustomControl)
	 private
			FBorderStyle: TBorderStyle;
			FCellWidth: Integer;
			FCurrencySymbol: string;
			FCurrencySymbolAligned: Boolean;
			FChineseCurrencyStr: string;
			FDecimalNumber: Integer;
			FDecimalSeparatorColor: TColor;
			FDigitalNumber: Integer;
			FFocusedColor: TColor;
			FGridLineColor: TColor;
			FGridLineWidth: Integer;
			FKilobitSeparatorColor: TColor;
			FMaxLength: Integer;
			FMoveOutAllowed: Boolean;
			FNegativeColor: TColor;
			FNegativeFont: TFont;
			FReadOnly: Boolean;
			FShowNegativeColor: Boolean;
			FShowNegativeFont: Boolean;
			FShowNegativeSign: Boolean;
			FTextLayout: TTextLayout;
			FValue: Currency;
			FZeroEmpty: Boolean;
			FOnChange: TNotifyEvent;
			FModified: Boolean;
			FOnBeforeChange: TNotifyEvent;
			FOnMoveOut: TKeyEvent;
			FCursorTimer: TTimer;
			FCursorVisible: Boolean;
			FCursorWidth: Integer;
			FCursorXPos: Integer;
			FCursorY: Integer;
			FDotLength: Integer;
			FFormatString: string;
			FWorkCellOffset: Integer;
			FWorkCellWidth: Integer;
			FNegativeSign: Integer;
			FOriginValue: Extended;

			procedure AutoInitialize;
			procedure AutoDestroy;

			function GetChineseCurrencyStr: string;
			procedure SetChineseCurrencyStr(Value: string);
			function GetBorderStyle: TBorderStyle;
			procedure SetBorderStyle(Value: TBorderStyle);
			function GetCellWidth: Integer;
			procedure SetCellWidth(Value: Integer);
			function GetCurrencySymbol: string;
			procedure SetCurrencySymbol(Value: string);
      function GetCurrencySymbolAligned: Boolean;
      procedure SetCurrencySymbolAligned(Value: Boolean);
      function GetDecimalNumber: Integer;
      procedure SetDecimalNumber(Value: Integer);
      function GetDecimalSeparatorColor: TColor;
      procedure SetDecimalSeparatorColor(Value: TColor);
      function GetDigitalNumber: Integer;
      procedure SetDigitalNumber(Value: Integer);
      function GetFocusedColor: TColor;
      procedure SetFocusedColor(Value: TColor);
      function GetGridLineColor: TColor;
			procedure SetGridLineColor(Value: TColor);
      function GetGridLineWidth: Integer;
      procedure SetGridLineWidth(Value: Integer);
      function GetKilobitSeparatorColor: TColor;
      procedure SetKilobitSeparatorColor(Value: TColor);
      function GetMaxLength: Integer;
      procedure SetMaxLength(Value: Integer);
      function GetMoveOutAllowed: Boolean;
      procedure SetMoveOutAllowed(Value: Boolean);
      function GetNegativeColor: TColor;
      procedure SetNegativeColor(Value: TColor);
      procedure SetNegativeFont(Value: TFont);
			function GetReadOnly: Boolean;
      procedure SetReadOnly(Value: Boolean);
      function GetShowNegativeColor: Boolean;
      procedure SetShowNegativeColor(Value: Boolean);
      function GetShowNegativeFont: Boolean;
      procedure SetShowNegativeFont(Value: Boolean);
      function GetShowNegativeSign: Boolean;
      procedure SetShowNegativeSign(Value: Boolean);
      function GetTextLayout: TTextLayout;
      procedure SetTextLayout(Value: TTextLayout);
      function GetValue: Currency;
      procedure SetValue(Value: Currency);
			function GetZeroEmpty: Boolean;
      procedure SetZeroEmpty(Value: Boolean);
      procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
      procedure CMEnter(var Message: TMessage); message CM_ENTER;
      procedure SyncCursorPos;
      procedure ChangeValue(Value: Extended);
      procedure CursorTimerHandle(Sender: TObject);
      procedure DecodeCursorX(X: Integer);
      procedure DrawCursor;
      procedure DrawGrid;
      procedure DrawText;
      function ArabiaToChinese(const ArabiaCurrency: Currency): string;
			procedure InitCursorX(X: Integer);
      procedure SetCursorState(Visible: Boolean);
      procedure WMChar(var Message: TMessage); message WM_CHAR;
      procedure WMKeyDown(var Message: TMessage); message WM_KEYDOWN;
      procedure CNKEYDOWN(var Message: TMessage); message CN_KEYDOWN;
      procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
      procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
      procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
   protected
      procedure BeforeChange; virtual;
      procedure MoveOut(var Key: Word; Shift: TShiftState); virtual;
      procedure Change; virtual;
			procedure CreateParams(var Params: TCreateParams); override;
      procedure Paint; override;
   public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      function Modified: Boolean;
      procedure UnDo;
   published
      property Color;
      property Ctl3D;
      property Font;
      property Enabled;
			property ParentColor;
      property ParentCtl3D;
      property ParentFont;
      property ParentShowHint;
      property ShowHint;
      property TabOrder;
      property TabStop;
      property Visible;
      property OnClick;
      property OnDblClick;
      property OnDragDrop;
      property OnEnter;
			property OnExit;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle
         default bsSingle;
      property CellWidth: Integer read GetCellWidth write SetCellWidth
         default -1;
      property CurrencySymbol: string read GetCurrencySymbol write SetCurrencySymbol;
			property CurrencySymbolAligned: Boolean read GetCurrencySymbolAligned write SetCurrencySymbolAligned
         default False;
      property DecimalNumber: Integer read GetDecimalNumber write SetDecimalNumber
         default 2;
      property DecimalSeparatorColor: TColor read GetDecimalSeparatorColor write SetDecimalSeparatorColor
         default clRed;
      property DigitalNumber: Integer read GetDigitalNumber write SetDigitalNumber
         default 10; { not clude dot }
      property FocusedColor: TColor read GetFocusedColor write SetFocusedColor
         default clYellow;
      ////
      property ChineseCurrencyStr: string read GetChineseCurrencyStr write SetChineseCurrencyStr;
			property GridLineColor: TColor read GetGridLineColor write SetGridLineColor
         default clSilver;
      property GridLineWidth: Integer read GetGridLineWidth write SetGridLineWidth
         default 1;
      property KilobitSeparatorColor: TColor read GetKilobitSeparatorColor write SetKilobitSeparatorColor
         default clBlack;
      property MaxLength: Integer read GetMaxLength write SetMaxLength
				 default FloatMaxLength; { 不包括小数点 }
      property MoveOutAllowed: Boolean read GetMoveOutAllowed write SetMoveOutAllowed
         default False;
      property NegativeColor: TColor read GetNegativeColor write SetNegativeColor
         default clRed;
			property NegativeFont: TFont read FNegativeFont write SetNegativeFont;
      property ReadOnly: Boolean read GetReadOnly write SetReadOnly
         default False;
      property ShowNegativeColor: Boolean read GetShowNegativeColor write SetShowNegativeColor
         default False;
      property ShowNegativeFont: Boolean read GetShowNegativeFont write SetShowNegativeFont
         default False;

      property ShowNegativeSign: Boolean read GetShowNegativeSign write SetShowNegativeSign
         default True;
      property TextLayout: TTextLayout read GetTextLayout write SetTextLayout
         default tlCenter;
			property Value: Currency read GetValue write SetValue;
      property ZeroEmpty: Boolean read GetZeroEmpty write SetZeroEmpty
         default True;
      property OnBeforeChange: TNotifyEvent read FOnBeforeChange write FOnBeforeChange;
      property OnMoveOut: TKeyEvent read FOnMoveOut write FOnMoveOut;
      property OnChange: TNotifyEvent read FOnChange write FOnChange;

	 end;
procedure Register;
const
   notext = ''; //提示
implementation

procedure Register;
begin
   RegisterComponents('WRCtrl', [TWNNumberEdit]);
   RegisterComponents('WRCtrl', [TWNCurrencyEdit]);
end;

{TWNNumberEdit}

constructor TWNNumberEdit.create(aowner: TComponent);
begin
	 inherited create(aowner);
	 isNullC:=true;
	 Text:='';
	 fdec := decimalseparator;
	 FAutoFormat := True;
	 fdigits := 1;
	 fmin := 0.00;
	 fmax := 99999999.99;
	 fertext := notext;
	 setvalue(0.0);
end;

destructor TWNNumberEdit.Destroy;
begin
	 inherited Destroy;
end;

procedure TWNNumberEdit.doenter;
begin
	 foldval := getvalue;
   inherited;
end;

procedure TWNNumberEdit.CheckPaste(var msg: tmessage);
var
   Tmp: string;
	 result: extended;
   WNClipBord: TClipboard;
begin
   WNClipBord := TClipboard.Create;
   tmp := WNClipBord.AsText;
   WNClipBord.Free;
   try
			result := strtofloat(tmp);
      inherited;
   except
      MessageBeep($FFFFFFFF);
   end;
end;

procedure TWNNumberEdit.SetAutoFormat(Value: Boolean);
begin
   if FAutoFormat <> Value then
   begin
      FAutoFormat := not FAutoFormat;
      SetValue(strtofloat(Text));
   end;
end;

procedure TWNNumberEdit.doexit;
var
   ts: string;
   result: extended;
begin
	 if Text<>'' then
	 begin
	 	isNullC:=False;
		 ts := text;
		 inherited;
		 try
				result := strtofloat(ts);
		 except
			if fertext <> notext then
				 showmessage(fertext);
			setvalue(foldval);
			selectall;
			setfocus;
			exit;
		 end;
		 if (result < fmin) or (result > fmax) then
		 begin
			if fertext <> notext then
				 showmessage(fertext);
			setvalue(foldval);
			selectall;
			setfocus;
			exit;
		 end;

		 text := floattostrf(Value, fffixed, 18, fdigits);
		 value := strtofloat(text);
	 end
	 else
	 Begin
		isNullC:=true;
		value:=0;
	 end;
	 inherited;
end;

procedure TWNNumberEdit.setvalue(Value: extended);
var
	 tmp: string;
begin
	 if isNullC=False then
	 begin
		 if Value > fmax then
		 begin
				if fertext <> notext then
					 showmessage(fertext);
				Value := fmax;
		 end;
		 if Value < fmin then
		 begin
				if fertext <> notext then
					 showmessage(fertext);
				Value := fmin;
		 end;
		 if FAutoFormat then
				tmp := floattostrf(Value, fffixed, 18, fdigits)
		 else
				tmp := floattostr(strtofloat(floattostrf(Value, fffixed, 18, fdigits)));
		 text := tmp;
	 end
	 else
		Text:='';

end;

function TWNNumberEdit.getvalue: extended;
var
	 ts: string;
begin
	 if Text='' then
	 begin
		result:=0;
		exit;
	 end;
	 ts := text;
	 if (ts = '-') or (ts = fdec) or (ts = '') then
			ts := '0';
	 try
			result := strtofloat(ts);
	 except
			result := fmin;
	 end;
	 if result < fmin then
	 begin
			result := fmin;
	 end;
	 if result > fmax then
	 begin
			result := fmax;
	 end;
end;

procedure TWNNumberEdit.setdigits(Value: byte);
begin
	 if fdigits <> Value then
	 begin
			if Value > 18 then
				 Value := 18;
			fdigits := Value;
			setvalue(getvalue);
	 end;
end;

procedure TWNNumberEdit.setmin(Value: extended);
begin
	 if fmin <> Value then
	 begin
			if Value > fmax then
			begin
				 showmessage('最小值不能够大于最大值!');
				 Value := fmin;
			end;
			fmin := Value;
			setvalue(getvalue);
	 end;
end;