可以左右居中对齐并可设置DisplayFormat的Edit控件

核心提示：欢迎测试！liang_z@163.netunit OWEdit;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TInputDataType = (tFloa

欢迎测试！

liang_z@163.net

unit OWEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TInputDataType = (tFloat,tInteger,tAll);

type
  TOWEdit = class(TEdit)
  PRivate
　  { Private declarations }
　  FCanvas : TCanvas;
　  FDataType: TInputDataType;
　  FAlignment : TAlignment;
　  FDisplayFormat : String;
　  FDeciNum : Word;
　  FDisplayText : String;
　  procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
　  { Protected declarations }
　  procedure SetDataType(Value:TInputDataType);
　  procedure SetAlignment(Value:TAlignment);
　  procedure SetDisplayFormat(Value:String);
　  procedure ClipPaste(var M:TMessage); Message WM_PASTE;
　  procedure PaintWindow(DC: HDC); override;
　  procedure Paint; virtual;
　  procedure WMExit(var Message:TWMKillFocus);Message WM_KILLFOCUS;
　  procedure GetDisplayText;
　  procedure ShowDisplayText;
　  function  GetDeciLast:integer;
  public
　  { Public declarations }
　  OldText : String;
　  property Text;
　  property Canvas: TCanvas read FCanvas;
　  constructor Create(AOwner: TComponent); override;
　  destructor Destroy(); override;
　  procedure KeyPress(var Key: Char); override;
　  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  published
　  { Published declarations }
　  property DataType: TInputDataType read fDataType write SetDataType default tFloat;
　  property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
　  property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Ourway', [TOWEdit]);
end;

constructor TOWEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Text := '0';
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  FDeciNum := 9999;
end;

destructor TOWEdit.Destroy();
begin
  FCanvas.Free;
  inherited Destroy();
end;

procedure TOWEdit.SetDataType(Value:TInputDataType);
begin
  If Value<>fDataType Then
  begin
　  fDataType := Value;
　  Case Value of
　　  tAll: Text := ';
　　  tFloat: Text:='0.0';
　　  tInteger: Text:='0';
　  end;
　  ShowDisplayText;
　  Invalidate;
  end;
end;

procedure TOWEdit.SetAlignment(Value:TAlignment);
begin
  If Value<>FAlignment Then
  begin
　  FAlignment := Value;
　  Invalidate;
  end;
end;

procedure TOWEdit.SetDisplayFormat(Value: string);
begin
  If Value<>FDisplayFormat Then
  begin
　  FDisplayFormat := Value;
　  if Trim(Value)<>' then
　　  FDeciNum := Length(Value)-Pos('.',Value)+1
　  else
　　  FDeciNum := 9999;
　  ShowDisplayText;
　  Invalidate;
  end;
end;

procedure TOWEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_DELETE then
　  if Self.SelStart=pos('.',Self.Text)-1 then
　　  Key := 0;
  inherited KeyDown(Key,Shift);
end;
procedure TOWEdit.KeyPress(var Key: Char);
var
  kv: Integer;
begin
  kv := Ord(Key);
  case fDataType of
　  tInteger:
　　  if (((kv>58) or (kv<48)) and (kv<>3) and (kv<>22) and (kv<>8) and (kv<>13)) then
　　　　 Key := chr(0);
　  tFloat:
　　  begin
　　　  if (((kv>58) or (kv<48)) and (kv<>3) and (kv<>22) and (kv<>46) and (kv<>8) and (kv<>13)) then
　　　　　 Key := chr(0)
　　　  else
　　　  begin
　　　　  if (kv=46) and (Pos('.',self.Text)>0) then//已有小数点
　　　　　  Key := chr(0)
　　　　  else
　　　　　  if MaxLength<1 then//小数点前面位数不定
　　　　　  begin
　　　　　　  if ((GetDeciLast>=FDeciNum) and (kv<>8)) then //退格键
　　　　　　　  if ((self.SelLength=0)and(pos('.',copy(Self.Text,1,self.SelStart))>0))then
　　　　　　　　  Key := chr(0);
　　　　　  end
　　　　　  else//输入总长度已定
　　　　　  begin
　　　　　　  if pos('.',copy(self.Text,1,self.selStart))<1 then
　　　　　　  begin//光标在小数点之前
　　　　　　　  if ((self.SelStart>=MaxLength-FDeciNum)and(kv<>8)and(kv<>46)) then
　　　　　　　　　  Key := chr(0);
　　　　　　  end
　　　　　　  else
　　　　　　  begin//光标在小数点之后
　　　　　　　  if ((GetDeciLast>=FDeciNum) and (kv<>8) and (self.SelLength=0)and(pos('.',copy(Self.Text,1,self.SelStart))>0)) then
　　　　　　　　　  Key := chr(0);
　　　　　　  end;
　　　　　  end;
　　　  end;
　　  end;
　  else
  end;
  if (kv=8)and(Self.SelStart>0)and(Self.Text[self.SelStart]='.')and(GetDeciLast>1) then
　  Key := chr(0);
  //还有一个Delete键没有截获！如果用此键删除小数点，还是有可能出错的。
  //搞定！用KeyDown override
  inherited KeyPress(Key);
end;

procedure TOWEdit.ClipPaste(var M:TMessage);
begin
  if fDataType=tAll then
　  inherited;
end;

procedure TOWEdit.WMPaint(var Message: TWMPaint);
begin
  inherited;
  PaintWindow(Message.DC);
end;

procedure TOWEdit.PaintWindow(DC: HDC);
begin
  FCanvas.Lock;
  try
　  FCanvas.Handle := DC;
　  try
　　  TControlCanvas(FCanvas).UpdateTextFlags;
　　  Paint;
　  finally
　　  FCanvas.Handle := 0;
　  end;
  finally
　  FCanvas.Unlock;
  end;
end;

procedure TOWEdit.Paint;
begin
  if not Focused then
  begin
　  ShowDisplayText;
  end
  else
　  inherited;
end;

procedure TOWEdit.WMExit(var Message:TWMKillFocus);
begin
  inherited;
  ShowDisplayText;
end;

procedure TOWEdit.GetDisplayText;
var
  ShowText : String;
begin
  ShowText := Text;
  if FDataType<>tAll then
  begin
　  if Trim(ShowText)=' then
　　  ShowText := '0';
　  if FDatatype=tFloat then
　　  ShowText := FormatFloat(FDisplayFormat,StrToFloat(ShowText))
　  else
　　  ShowText := FormatFloat(FDisplayFormat,StrToInt(ShowText));
  end;
  FDisplayText := ShowText;
end;

procedure TOWEdit.ShowDisplayText;
var
  Rect : TRect;
  x,y : Integer;
begin
  GetDisplayText;
  Canvas.Lock;
  try
　  Rect.Left := 1;
　  Rect.Top := 1;
　  Rect.Right := Width-1;
　  Rect.Bottom:= Height-1;
　  Canvas.Font := Font;
　  if not Enabled then
　　  Canvas.Font.Color := clGrayText;
　  Canvas.Brush.Color:=Self.Color;
　  Canvas.FillRect(Rect);
　  y := 2; x := 2;
　  Case FAlignment of
　　  taLeftJustify:;
　　  taRightJustify:
　　　  x := Width-Canvas.TextWidth(FDisplayText)-5;
　  else
　　  x := (Width-Canvas.TextWidth(FDisplayText)-5)div 2;
　  end;
　  Canvas.TextOut(x,y,FDisplayText);
  finally
　  Canvas.Unlock;
  end;
end;

function TOWEdit.GetDeciLast:integer;
var
  i : Integer;
begin
  Result := 0;
  if Pos('.',Text)>0 then
  begin
　  for i:=1 to Length(Text) do
　　  if Text[i]='.' then
　　  begin
　　　  Result := Length(Text)-i+1;//Length(Copy(Text,i,Length(Text)-i));
　　　  Exit;
　　  end;
  end;
end;

end.