用这个就可以
unit IPFieldEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TIPFieldEdit = class(TEdit)
private
{ Private declarations }
FError: Boolean;
FMin, FMax: BYTE;
FValue: BYTE;
protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams); override;
procedure KeyPress(var Key: Char); override;
procedure TextChanged(Sender: TObject);
procedure WMKeyDown(var Message: TWMKEy); message WM_KEYDOWN;
procedure SetMin(value: Byte);
procedure SetMax(value: Byte);
procedure SetValue(value: Byte);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetCurrentPosition: integer;
procedure SetCurrentPosition(Value: integer);
property CurrentPosition: integer read GetCurrentPosition write SetCurrentPosition;
property Value: Byte read FValue write SetValue;
property Error: Boolean read FError;
property Min: Byte read FMin write SetMin default 0;
property Max: Byte read FMax write SetMax default 255;
property ReadOnly stored False;
published
{ Published declarations }
end;
implementation
{ TIPFieldEdit }
uses IPEdit;
procedure TIPFieldEdit.SetMin(value: Byte);
begin
FMin := value;
if FMax < FMin then
FMax := FMin;
end;
procedure TIPFieldEdit.SetMax(value: Byte);
begin
FMax := value;
if FMin > FMax then
FMin := FMax;
end;
procedure TIPFieldEdit.SetValue(value: Byte);
begin
FValue := value;
Text := inttostr(value)
end;
procedure TIPFieldEdit.KeyPress(var Key: Char);
begin
if (Key >= '0') and (Key <= '9') then
begin
inherited;
end
else
begin
if (Key = '.') and (SelLength = 0) and (Text <> '') then
(Parent as TIPEdit).ActiveNextField(True);
if Key <> #8 then
Key := #0
else if CurrentPosition = 0 then
(Parent as TIPEdit).ActivePrevField;
end;
end;
procedure TIPFieldEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or (ES_CENTER or Es_MULTILINE);
end;
constructor TIPFieldEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FError := False;
Text := '0';
FMin := 0;
FMax := 255;
MaxLength := 3;
ParentFont := True;
ParentColor := True;
BorderStyle := bsNone;
OnChange := TextChanged;
end;
destructor TIPFieldEdit.Destroy;
begin
inherited Destroy;
end;
procedure TIPFieldEdit.TextChanged(Sender: TObject);
var
v, er: integer;
begin
inherited;
if Text <> '' then
begin
Val(Text, v, er);
if (er <> 0) or (v < FMin) or (v > FMax) then
begin
FError := True;
with (Parent as TIPEdit) do
begin
if Assigned(OnError) then
OnError(Parent, Self.TabOrder);
Text:='255';//赵明达 2002.07.16
end;
end
else
begin
FError := False;
if (FValue <> v) then
begin
FValue := v;
with (Parent as TIPEdit) do
if Assigned(OnChange) then
OnChange(Parent);
end;
end;
end;
if not FError and (Length(Text) = 3) and (CurrentPosition = 3) then
(Parent as TIPEdit).ActiveNextField(True);
end;
function TIPFieldEdit.GetCurrentPosition: integer;
{Get character position of cursor within line}
begin
result := SelStart - SendMessage(Handle, EM_LINEINDEX,
(SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0)), 0);
end;
procedure TIPFieldEdit.SetCurrentPosition(Value: integer);
var
curposn: integer;
begin
{Value must be within range}
curposn := Value;
if curposn < 0 then
curposn := 0;
if curposn > Length(Text) then
curposn := Length(Text);
{Put cursor in selected position}
SelStart := SendMessage(Handle, EM_LINEINDEX, 0, 0) + curposn;
end;
procedure TIPFieldEdit.WMKeyDown(var Message: TWMKey);
begin
with Message do
if (CharCode = VK_RIGHT)
and (CurrentPosition >= Length(Text)) then
begin
SelLength := 0;
(Parent as TIPEdit).ActiveNextField;
Result := 1;
end
else if (CharCode = VK_LEFT)
and (CurrentPosition = 0) then
begin
SelLength := 0;
(Parent as TIPEdit).ActivePrevField;
Result := 1;
end
else
inherited;
end;
end.
//----------------------------Unit2---------------------------
{ Tihs component is distributed as a freeware. You can use it freely, but if you do
some modifications on this code, please let me know. Bug report and upgrade suggestion
are Welcome.
Description: An enhanced TEdit component for Inputing IP address
Author: Joe Zhang (huilong@szonline.net)
Date: 13 Dec 2000
Properties
IPString: An IP string like 'xxx.xxx.xxx.xxx', if current input is invalid, then this
string is empty;
Addr: 32bit IP value, if current input is invalid, then this value is 0.
Events
OnChange: Generate after valid IP changed.
OnError: Generate when the input is invalid.
}
unit IPEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, IPFieldEdit;
type
TIPErrorEvent = procedure(Sender: TObject; Field: integer) of Object;
TIPEdit = class(TCustomControl)
private
FFields: array [0..3] of TIPFieldEdit;
/////////
FBorderStyle: TBorderStyle;
FFullRepaint: Boolean;
FOnError: TIPErrorEvent;
FOnChange: TNotifyEvent;
procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED;
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
//procedure CMSizeChange(var Message:TMessage);message CM_
protected
procedure ArrangeFields();
procedure CreateParams(var Params: TCreateParams); override;
procedure AdjustClientRect(var Rect: TRect); override;
procedure Paint(); override;
property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True;
function GetMin(idx: integer): Byte;
procedure SetMin(idx: integer; value: Byte);
function GetMax(idx: integer): Byte;
procedure SetMax(idx: integer; value: Byte);
function GetIPString: string;
procedure SetIPString(value: string);
function GetIPError: boolean;
function GetAddr: integer;
procedure SetAddr(value: integer);
function FocusIndex: integer;
function GetFields(idx: integer): TIPFieldEdit;
function GetTabStop: Boolean;
procedure SetTabStop(value: Boolean);
procedure SetReadOnly(value: Boolean);
function GetReadOnly: Boolean;
procedure SetBorderStyle(Value: TBorderStyle);
function GetCursor(): TCursor;
procedure SetCursor(Value: TCursor);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ActiveNextField(Sel: Boolean = False);
procedure ActivePrevField(Sel: Boolean = False);
property Min[index: integer]: Byte read GetMin write SetMin;
property Max[index: integer]: Byte read GetMax write SetMax;
property Addr: integer read GetAddr write SetAddr;
property Fields[index: integer]: TIPFieldEdit read GetFields;
published
property IPString: string read GetIPString write SetIPString;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property Color;
property Cursor: TCursor Read GetCursor write SetCursor;
property Font;
property Enabled;
property Error: Boolean read GetIPError;
property ParentColor default False;
property ParentFont default True;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop: Boolean read GetTabStop write SetTabStop default True;
property Visible;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnError: TIPErrorEvent read FOnError write FOnError;
property OnEnter;
property OnExit;
end;
procedure Register;
implementation
{ TIPEdit }
constructor TIPEdit.Create(AOwner: TComponent);
var
i: integer;
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
ParentFont := True; ///////// false
FBorderStyle := bsSingle;
FFullRepaint := True;
UseDockManager := True;
for i := 0 to 3 do
begin
FFields := TIPFieldEdit.Create(Self);
FFields.Parent := Self;
end;
Cursor := crIBeam;
Width := 125;
Height := 21;
Font.Size:=9;
Font.Style:=[fsBold];
TabStop := True;
ParentColor := False;
ArrangeFields();
end;
destructor TIPEdit.Destroy;
var
i: integer;
begin
for i := 0 to 3 do
FFields.Free;
inherited;
end;
procedure TIPEdit.CreateParams(var Params: TCreateParams);
const
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or BorderStyles[FBorderStyle];
if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TIPEdit.CMBorderChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TIPEdit.CMColorChanged(var Message: TMessage);
begin //
inherited;
Invalidate;
end;
procedure TIPEdit.CMFontChanged(var Message: TMessage);
begin //
inherited;
Invalidate;
ArrangeFields();
end;
procedure TIPEdit.CMCtl3DChanged(var Message: TMessage);
begin
if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
inherited;
end;
procedure TIPEdit.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
BevelPixels: Integer;
Rect: TRect;
begin
if FullRepaint or (Caption <> '') then
Invalidate()
else
begin
BevelPixels := BorderWidth;
// if BevelInner <> bvNone then Inc(BevelPixels, BevelWidth);
// if BevelOuter <> bvNone then Inc(BevelPixels, BevelWidth);
if BevelPixels > 0 then
begin
Rect.Right := Width;
Rect.Bottom := Height;
if Message.WindowPos^.cx <> Rect.Right then
begin
Rect.Top := 0;
Rect.Left := Rect.Right - BevelPixels - 1;
InvalidateRect(Handle, @Rect, True);
end;
if Message.WindowPos^.cy <> Rect.Bottom then
begin
Rect.Left := 0;
Rect.Top := Rect.Bottom - BevelPixels - 1;
InvalidateRect(Handle, @Rect, True);
end;
end;
end;
inherited;
end;
procedure TIPEdit.Paint();
const
Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
Rect: TRect;
// h, t,
l, w: integer;
d: integer;
t,h:Integer; //我的变量
begin
// h := Abs(Font.Height) + 2;
// t := (Height - h - 4) div 2;
w := Abs(Font.Size) * 3; //字体的大小
d := w div 9+1;
l := (Width - w * 4 - d * 3 - 4) div 2;
Rect := GetClientRect;
h := Abs(Font.Height)+2; // Abs(Font.Height) + 2;
t := (Height - h - 4) div 2 +1; //(Height - h - 4) div 2 +1;
Frame3D(Canvas, Rect, clBtnHighlight, clBtnShadow, BorderWidth);
with Canvas do
begin
Brush.Color := Color;//Self.Color;
FillRect(Rect);
Brush.Style := bsClear;
Font.Assign(Self.Font);
Font.Style := [fsBold];
Font.Size:=18;
Rect.Top := t-(18-w div 3);//FFields[0].Top;
Inc(l, w);
Inc(Rect.Left, l);
Canvas.TextOut(Rect.Left, Rect.Top, '.');
Inc(Rect.Left, w + d);
Canvas.TextOut(Rect.Left, Rect.Top, '.');
Inc(Rect.Left, w + d);
Canvas.TextOut(Rect.Left, Rect.Top, '.');
end;
end;
procedure TIPEdit.SetBorderStyle(Value: TBorderStyle);
begin
if FBorderStyle <> Value then
begin
FBorderStyle := Value;
RecreateWnd;
end;
end;
function TIPEdit.GetCursor(): TCursor;
begin
Result := inherited Cursor;
end;
procedure TIPEdit.SetCursor(Value: TCursor);
var
i: integer;
begin
inherited Cursor := Value;
for i := 0 to 3 do
FFields.Cursor := Value;
end;
procedure TIPEdit.AdjustClientRect(var Rect: TRect);
//var
// BevelSize: Integer;
begin
inherited AdjustClientRect(Rect);
InflateRect(Rect, -BorderWidth, -BorderWidth);
// BevelSize := 0;
// if BevelOuter <> bvNone then Inc(BevelSize, BevelWidth);
// if BevelInner <> bvNone then Inc(BevelSize, BevelWidth);
// InflateRect(Rect, -BevelSize, -BevelSize);
end;
procedure TIPEdit.ArrangeFields();
var
i: integer;
l, t, h, w: integer;
d: integer; // dot width, half of size
m:integer;
begin
if not Assigned(Parent) then
Exit;
m:=Height-2;//自己加入一个高度
h := Abs(Font.Height)+2; // Abs(Font.Height) + 2;
t := (Height - h - 4) div 2 +1; //(Height - h - 4) div 2 +1;
w := Abs(Font.Size) * 3;
d := w div 9+1;
l := (Width - w * 4 - d * 3 - 4) div 2;
for i := 0 to 3 do
with FFields do
begin
SetBounds(l, t, w, m); //设置边界 SetBounds(l, t, w, h);
l := l + w + d;
end;
end;
procedure TIPEdit.ActivePrevField(Sel: Boolean);
var
i: integer;
begin
i := 3;
while i >= 1 do
begin
if FFields.Focused then
Break;
Dec(i);
end;
if i >= 1 then
begin
if Sel then
FFields[i-1].SelectAll
else
FFields[i-1].CurrentPosition := 3;
FFields[i-1].SetFocus;
end
end;
procedure TIPEdit.ActiveNextField(Sel: Boolean);
var
i: integer;
begin
i := 0;
while i <= 2 do
begin
if FFields.Focused then
Break;
Inc(i);
end;
if i <= 2 then
begin
if Sel then
FFields[i+1].SelectAll
else
FFields[i+1].CurrentPosition := 0;
FFields[i+1].SetFocus;
end
end;
function TIPEdit.GetMin(idx: integer): Byte;
begin
Result := FFields[idx].Min;
end;
procedure TIPEdit.SetMin(idx: integer; value: Byte);
begin
FFields[idx].Min := value;
end;
function TIPEdit.GetMax(idx: integer): Byte;
begin
Result := FFields[idx].Max;
end;
procedure TIPEdit.SetMax(idx: integer; value: Byte);
begin
FFields[idx].Max := value;
end;
function TIPEdit.GetIPString: string;
var
i: integer;
begin
Result := '' ;
for i := 0 to 3 do
begin
if FFields.Error then
begin
Result := '255';
Exit;
end;
Result := Result + inttostr(FFields.Value);
if i < 3 then
Result := Result + '.';
end;
end;
function getnum(var st: string): integer;
var
s: string;
i, err: integer;
begin
i := Pos('.', st);
if i > 0 then
s := Copy(st, 1, i-1)
else
s := st;
Delete(st, 1, i-1);
Val(s, result, err);
if (err <> 0) or (result > 255) or (result < 0) then
result := -1;
end;
function getdot(var st: string):integer; // -1 err;
begin
if (Length(st)>0) and (st[1]='.') then
begin
Delete(st, 1, 1);
Result := 0;
end
else
Result := -1;
end;
procedure TIPEdit.SetIPString(value: string);
var
v: array [0..3] of byte;
i, k: integer;
begin
for i:=0 to 3 do
begin
k := getnum(value);
if (k < 0) or (k > 255) then
k:=255; //赵明达
//Exit; //赵明达
v := k;
if (i<>3) then
if getdot(value) < 0 then
Exit;
end;
for i:=0 to 3 do
FFields.Value := v;
end;
function TIPEdit.GetIPError: boolean;
begin
Result := FFields[0].Error or FFields[1].Error or
FFields[2].Error or FFields[3].Error;
end;
function TIPEdit.GetAddr: integer;
type
DWORDSTRUCT = Record
case integer of
0: (b: array [0..3] of Byte);
1: (w: array [0..1] of word);
2: (d: integer);
end;
var
v: DWORDSTRUCT;
i: integer;
begin
if Error then
Result := 0
else
begin
for i := 0 to 3 do
v.b := FFields.Value;
Result := v.d;
end;
end;
procedure TIPEdit.SetAddr(value: integer);
type
DWORDSTRUCT = Record
case integer of
0: (b: array [0..3] of Byte);
1: (w: array [0..1] of word);
2: (d: integer);
end;
var
v: DWORDSTRUCT;
i: integer;
begin
v.d := value;
for i := 0 to 3 do
begin
FFields.Value := v.b;
end;
end;
function TIPEdit.FocusIndex: integer;
var
i: integer;
begin
Result := -1;
for i := 0 to 3 do
if FFields.Focused then
Result := i;
end;
procedure TIPEdit.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
ArrangeFields();
end;
procedure TIPEdit.WMLButtonDown(var Message: TWMLButtonDown);
begin
inherited;
if FocusIndex < 0 then
FFields[0].SetFocus;
end;
function TIPEdit.GetFields(idx: integer): TIPFieldEdit;
begin
Result := FFields[idx];
end;
{procedure TIPEdit.SetColor(Value: TColor);
var
i: integer;
begin
if inherited Color <> Value then
begin
inherited Color := Value;
// for i := 0 to 3 do
// FFields.Color := Value;
end;
end;
function TIPEdit.GetColor: TColor;
begin
Result := inherited Color;
end;
}
function TIPEdit.GetTabStop: Boolean;
begin
Result := inherited TabStop;
end;
procedure TIPEdit.SetTabStop(value: Boolean);
var
i: integer;
begin
if value <> inherited TabStop then
begin
inherited TabStop := value;
for i := 0 to 3 do
FFields.TabStop := value;
end;
end;
procedure TIPEdit.SetReadOnly(value: Boolean);
var
i: integer;
begin
if ReadOnly <> value then
for i := 0 to 3 do
FFields.ReadOnly := value;
end;
function TIPEdit.GetReadOnly: Boolean;
begin
Result := FFields[0].ReadOnly;
end;
procedure TIPEdit.CMEnter(var Message: TCMEnter);
begin
FFields[0].SetFocus;
inherited;
end;
procedure Register;
begin
RegisterComponents('Standard', [TIPEdit]);
end;
end.