ipedit.pas

用delphi写的IP组件源码

{ 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 ([e-mail])
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[i] := TIPFieldEdit.Create(Self);
    FFields[i].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[i].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[i].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[i] 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[i].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[i].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[i].Error then
    begin
      Result := '255';
      Exit;
    end;
    Result := Result + inttostr(FFields[i].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[i] := k;
    if (i<>3) then
      if getdot(value) < 0 then
        Exit; 
  end;
  for i:=0 to 3 do
    FFields[i].Value := v[i];
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[i] := FFields[i].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[i].Value := v.b[i];
  end;
end;

function TIPEdit.FocusIndex: integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to 3 do
  if FFields[i].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[i].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[i].TabStop := value;
  end;
end;

procedure TIPEdit.SetReadOnly(value: Boolean);
var
  i: integer;
begin
  if ReadOnly <> value then
    for i := 0 to 3 do
      FFields[i].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.