开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MdNumEd.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：3k
源码类别：

Delphi控件源码

开发平台：

Delphi

MdNumEd.pas：源码内容
  1. unit MdNumEd;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls;
  8. type
  9.   TMdNumEdit = class (TCustomEdit)
  10.   private
  11.     fInputError: TNotifyEvent;
  12.   protected
  13.     function GetValue: Integer;
  14.     procedure SetValue (Value: Integer);
  15.   public
  16.     procedure WmChar (var Msg: TWmChar); message wm_Char;
  17.     constructor Create (Owner: TComponent); override;
  18.   published
  19.     property OnInputError: TNotifyEvent
  20.       read fInputError write fInputError;
  21.     property Value: Integer
  22.       read GetValue write SetValue default 0;
  23.     property AutoSelect;
  24.     property AutoSize;
  25.     property BorderStyle;
  26.     property CharCase;
  27.     property Color;
  28.     property Ctl3D;
  29.     property DragCursor;
  30.     property DragMode;
  31.     property Enabled;
  32.     property Font;
  33.     property HideSelection;
  34.     property MaxLength;
  35.     property OEMConvert;
  36.     property ParentColor;
  37.     property ParentCtl3D;
  38.     property ParentFont;
  39.     property ParentShowHint;
  40.     property PasswordChar;
  41.     property PopupMenu;
  42.     property ReadOnly;
  43.     property ShowHint;
  44.     property TabOrder;
  45.     property TabStop;
  46.     property Visible;
  47.     property OnChange;
  48.     property OnClick;
  49.     property OnDblClick;
  50.     property OnDragDrop;
  51.     property OnDragOver;
  52.     property OnEndDrag;
  53.     property OnEnter;
  54.     property OnExit;
  55.     property OnKeyDown;
  56.     property OnKeyPress;
  57.     property OnKeyUp;
  58.     property OnMouseDown;
  59.     property OnMouseMove;
  60.     property OnMouseUp;
  61.   end;
  63.   TMdThousandEdit = class (TMdNumEdit)
  64.   public
  65.     procedure Change; override;
  66.   end;
  68. procedure Register;
  70. implementation
  72. constructor TMdNumEdit.Create (Owner: TComponent);
  73. begin
  74.   inherited Create (Owner);
  75.   Value := 0;
  76. end;
  78. function TMdNumEdit.GetValue: Integer;
  79. begin
  80.   // set to 0 in case of error
  81.   Result := StrToIntDef (Text, 0);
  82. end;
  84. procedure TMdNumEdit.SetValue (Value: Integer);
  85. begin
  86.   Text := IntToStr (Value);
  87. end;
  89. procedure TMdNumEdit.WmChar (var Msg: TWmChar);
  90. begin
  91.   if not (Char (Msg.CharCode) in ['0'..'9']) and not (Msg.CharCode = 8) then
  92.   begin
  93.     if Assigned (fInputError) then
  94.       fInputError (Self);
  95.   end
  96.   else
  97.     inherited;
  98. end;
  100. procedure Register;
  101. begin
  102.   RegisterComponents ('Md', [TMdNumEdit, TMdThousandEdit]);
  103. end;
  105. { TMdCurrencyEdit }
  107. function StringToFloatSkipping (s: string): Extended;
  108. var
  109.   s1: string;
  110.   I: Integer;
  111. begin
  112.   // remove non-numbers, but keep the decimal separator
  113.   s1 := '';
  114.   for i := 1 to length (s) do
  115.    if s[i] in ['0'..'9'] then
  116.      s1 := s1 + s[i];
  117.   Result := StrToFloat (s1);
  118. end;
  120. procedure TMdThousandEdit.Change;
  121. var
  122.   CursorPos, // original position of the cursor
  123.   LengthDiff: Integer; // number of new separators (+ or -)
  124. begin
  125.   if Assigned (Parent) then
  126.   begin
  127.     CursorPos := SelStart;
  128.     LengthDiff := Length (Text);
  129.     Text := FormatFloat ('#,###',
  130.       StringToFloatSkipping (Text));
  131.     LengthDiff := Length (Text) - LengthDiff;
  132.     // move the cursor to the proper position
  133.     SelStart := CursorPos + LengthDiff;
  134.   end;
  135.   inherited;
  136. end;
  138. end.