欢迎测试！
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.
