wnnumberedit.pas

自己做的通讯录程序

{**********************************************************
*  编辑框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 }

      constructor create(aowner: TComponent); override;
      destructor Destroy; override;
   published
      { Published-Deklarationen }

      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);
   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
   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);
   inherited;
end;

procedure TWNNumberEdit.setvalue(Value: extended);
var
   tmp: string;
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;

function TWNNumberEdit.getvalue: extended;
var
   ts: string;
begin
   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;

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

procedure TWNNumberEdit.keypress;
var
   ts: string;