Welcome!
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); OVE rride; 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;
PROCEDURE register;
IMPLEMENTATION
Procedure Register; Begin RegisterComponents ('OURWAY', [Towedit]);
constructor TOWEdit.Create (AOwner: TComponent); begin inherited Create (AOwner); Text: = '0'; FCanvas: = TControlCanvas.Create; TControlCanvas (FCanvas) .Control: = Self; FDeciNum: = 9999; end; destructor TOWEdit . F fcanvas.free; inherited destroy ();
Procedure toEDit.SetDataType (Value: TinputDataType); Begin if Value <> fdattype the beginning, case: text: = '; tvert: text: =' 0.0 '; tinteger: text: =' 0 '; End; showdisplaytext; invalidate; end;
Procedure towedit.setAlignment (Value: Talignment); Begin IF Value <> falignment the begin fixment: = value; invalidate; end;
Procedure toEDit.SetDisplayFormat (value: string); Begin if value <> fdisplayformat: = value; if trim (value) <> 'Then fdecinum: = length (value) -pos ('. ', value) 1 else fdecinum: = 9999; showdisplaytext; invalidate; end;
Procedure towedit.keydown (var key: word; shift: tshiftstate); begin if key = vk_delete kiln = pOS ('.', self.text) -1 the 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 // has a decimal point key: = chr (0) else if maxlength <1 THEN / / decimal point front bit number begin IF ((GetDecilast> = fdecinum) and (kv <> 8)) THEN // Retogene IF ((Self.sellength = 0) and (POS ('.', Copy (Self.Text, 1, Self.Selstart) )> 0)) THEN key: = chr (0); END ELSE // Input Total length has been fixed Begin IF P OS ('.', copy (self.text, 1, self.selstart) <1 the begin // cursor before the decimal point IF ((Self.selstart> = maxlength-fdecinum) and (kv <> 8) and ( KEY: = CHR (0); Else Begin // Cursor After the decimal point, IF ((GetDecilast> = fdecinum) and (kv <> 8) and (Self.sellength = 0) and (POS ('.', Copy (Self.Text, 1, Self.selStart)> 0)) "))")) ")) The key: = chr (0); end; end; end; end; else end; if (kv = 8) and (kV = 8) Self.Selstart>
0) And (self.text [self.selstart] = '.') And (getDecilast> 1) THEN key: = chr (0); // There is also a delete button without interception! If you use this button to delete a decimal point, it is still possible to erode. // Get it! Using Keydown Override Inherited KeyPress (key); end; procedure towedit.clippaste (var m: tMessage); begin if fdattype = tall.
Procedure Towedit.wmpaint (var message: twmpaint); begin inherited; Paintwindow (Message.dc);
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; el else inherited;
Procedure Towedit.wmexit (var message: twmkillfocus); begin inherited; showdisplaytext;
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); END; fdisplaytext: = showtext;
Procedure toedit.showdisplaytext; var reccT: TRECT; X, Y: integer; begin getDisplaytext; canvas.lock; try rest: = 1; Rect.top: = 1; Rect.Right: = Width-1; Rect.Bottom : = Height-1; canvas.font: = font; if not enabled the 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; functedit.getDecilast: Integer; var i: integer; begin result: = 0; if Pos ('.', text)> 0 THEN Begin for i : = 1 to Length (text) Do if text [i] = '.' Ten Begin Result: = Length (Text) -i 1; // Length (text, i, length (text))) ;
End.
