unit uIPEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls;

type
  TCustomIPEdit = class(TWinControl)
  private
    { Private declarations }
    FIPAddress: DWORD;
    FIPLimits: array[0..3] of word;
    FCurrentField: Integer;
   //procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
   //procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  protected
   { Protected declarations }
    function GetIP(Index: Integer): Byte;
    procedure SetIP(Index: Integer; Value: Byte);
    function GetMinIP(Index: Integer): Byte;
    procedure SetMinIP(Index: Integer; Value: Byte);
    function GetMaxIP(Index: Integer): Byte;
    procedure SetMaxIP(Index: Integer; Value: Byte);
    function GetIPString: string;
    procedure SetIPString(Value: string);
    function IsBlank: boolean;
    procedure SetCurrentField(Index: Integer);
   //
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
   //procedure KeyDown(var Key: Word; Shift: TShiftState);override;
    function IPDwordToString(dw: DWORD): string;
    function IPStringToDword(s: string): DWORD;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    property IP[Index: Integer]: byte read GetIP write SetIP;
    property MinIP[Index: Integer]: byte read GetMinIP write SetMinIP;
    property MaxIP[Index: Integer]: byte read GetMaxIP write SetMaxIP;
    property IPString: string read GetIPString write SetIPString;
    property CurrentField: Integer read FCurrentField write SetCurrentField;
    procedure Clear;

  end;

  TIPEdit = class(TCustomIPEdit)
  published
    property Align;
    property Anchors;
    property BorderWidth;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Hint;
    property Constraints;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    { Published declarations }
    property IPString;
  end;

procedure Register;

implementation

uses Graphics, commctrl, comctrls;

constructor TCustomIPEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIPAddress := 0;
  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
  Color := clBtnFace;
  Width := 160;
  Height := 25;
  Align := alNone;
  TabStop := True;
end;

procedure TCustomIPEdit.CreateParams(var Params: TCreateParams);
begin
  InitCommonControl(ICC_INTERNET_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, WC_IPADDRESS);
  with Params do
  begin
    Style := WS_VISIBLE or WS_BORDER or WS_CHILD;
    if NewStyleControls and Ctl3D then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

procedure TCustomIPEdit.CreateWnd;
var i: Integer;
begin
  inherited CreateWnd;
  Clear;
{ for i := 0 to 3 do
  begin
   MinIP[i] := 0;
   MaxIP[i] := $FF;
  end;}
  CurrentField := 0;
end;

procedure TCustomIPEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result := {Message.Result or} DLGC_WANTTAB;
end;


procedure TCustomIPEdit.CNNotify(var Message: TWMNotify);
begin
  with Message.NMHdr^ do begin
    case Code of
      IPN_FIELDCHANGED:
        begin
          FCurrentField := PNMIPAddress(Message.NMHdr)^.iField;
          {if Assigned(OnIpFieldChange) then
            with PNMIPAdress(Message.NMHdr)^ do begin
               OnIPFieldChange(Self, iField, iValue);}
        end;
    end;
  end;
end;

{procedure TCustomIPEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
 inherited KeyDown( Key, Shift );
 if Key = VK_TAB then
  if ssShift in Shift then
     CurrentField := (CurrentField - 1 + 4) mod 4
    else
     CurrentField := (CurrentField + 1) mod 4;
end;}

{procedure TCustomIPEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
  inherited;
  //Msg.Result := Ord(Char(Msg.CharCode) = #9);
end;}

procedure TCustomIPEdit.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if CharCode = VK_TAB then
    begin
      Message.Result := 0;
      if GetKeyState(VK_SHIFT) <> 0 then
      begin
        if (CurrentField = 0) then Exit;
        CurrentField := CurrentField - 1;
      end
      else
      begin
        if (CurrentField = 3) then Exit;
        CurrentField := CurrentField + 1;
      end;
      Message.Result := 1;
    end //VK_TAB
    else
      inherited;
end;

{procedure TCustomIPEdit.CMDialogKey(var Message: TCMDialogKey);
begin
  if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and
    (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
   begin
    if GetKeyState(VK_SHIFT)<>0 then
     CurrentField := (CurrentField - 1 + 4) mod 4
    else
     CurrentField := (CurrentField + 1) mod 4;
    Message.Result := 1;
   end
 else
  inherited;
end;}


function TCustomIPEdit.GetIP(Index: Integer): Byte;
begin
  SendMessage(Handle, IPM_GETADDRESS, 0, longint(@FipAddress));
  case Index of
    1: Result := FIRST_IPADDRESS(FipAddress);
    2: Result := SECOND_IPADDRESS(FipAddress);
    3: Result := THIRD_IPADDRESS(FipAddress);
    4: Result := FOURTH_IPADDRESS(FipAddress);
  else Result := 0;
  end;
end;

procedure TCustomIPEdit.SetIP(Index: Integer; Value: Byte);
begin
  case Index of
    1: FIPAddress := FIPAddress and $FFFFFF or DWORD(Value) shl 24;
    2: FIPAddress := FIPAddress and $FF00FFFF or DWORD(Value) shl 16;
    3: FIPAddress := FIPAddress and $FFFF00FF or DWORD(Value) shl 8;
    4: FIPAddress := FIPAddress and $FFFFFF00 or DWORD(Value);
  else Exit;
  end;
  SendMessage(Handle, IPM_SETADDRESS, 0, FIPAddress);
end;

function TCustomIPEdit.GetMinIP(Index: Integer): Byte;
begin
  if (Index < 0) or (Index > 3) then
    Result := 0
  else
    Result := LoByte(FIPLimits[Index]);
end;

procedure TCustomIPEdit.SetMinIP(Index: Integer; Value: Byte);
begin
  if (Index < 0) or (Index > 3) then Exit;
  FIPLimits[Index] := MAKEIPRANGE(HiByte(FIPLimits[Index]), Value);
  SendMessage(Handle, IPM_SETRANGE, Index, FIPLimits[Index]);
end;

function TCustomIPEdit.GetMaxIP(Index: Integer): Byte;
begin
  if (Index < 0) or (Index > 3) then
    Result := 0
  else
    Result := HiByte(FIPLimits[Index]);
end;

procedure TCustomIPEdit.SetMaxIP(Index: Integer; Value: Byte);
begin
  if (Index < 0) or (Index > 3) then Exit;
  FIPLimits[Index] := MAKEIPRANGE(Value, LoByte(FIPLimits[Index]));
  SendMessage(Handle, IPM_SETRANGE, Index, FIPLimits[Index]);
end;

procedure TCustomIPEdit.Clear;
begin
  SendMessage(Handle, IPM_CLEARADDRESS, 0, 0);
end;

function TCustomIPEdit.IsBlank: boolean;
begin
  Result := SendMessage(Handle, IPM_ISBLANK, 0, 0) = 0;
end;

procedure TCustomIPEdit.SetCurrentField(Index: Integer);
begin
  if (Index < 0) or (Index > 3) then Exit;
  FCurrentField := Index;
  SendMessage(Handle, IPM_SETFOCUS, wParam(FCurrentField), 0);
end;

function TCustomIPEdit.IPDwordToString(dw: DWORD): string;
begin
  Result := Format('%d.%d.%d.%d',
    [FIRST_IPADDRESS(dw),
    SECOND_IPADDRESS(dw),
      THIRD_IPADDRESS(dw),
      FOURTH_IPADDRESS(dw)]);
end;

function TCustomIPEdit.IPStringToDword(s: string): DWORD;
var i, j: Integer;
  NewAddr, Part: DWORD;
begin
  NewAddr := 0;
  try
    i := 0;
    repeat
      j := Pos('.', s);
      if j <= 1 then
        if i < 3 then
          Abort
        else
          Part := StrToInt(s)
      else
        Part := StrToInt(Copy(s, 1, j - 1));
      if Part > 255 then Abort;
      Delete(s, 1, j);
      NewAddr := (NewAddr shl 8) or Part;
      Inc(i);
    until i > 3;
    Result := NewAddr;
  //Windows.MessageBox( 0, pChar(IntToHex(FIPAddress, 8 )), '', MB_Ok );
  except
  end;

end;

function TCustomIPEdit.GetIPString: string;
begin
  SendMessage(Handle, IPM_GETADDRESS, 0, longint(@FIPAddress));
  Result := IpDwordToString(FIPAddress);
end;

procedure TCustomIPEdit.SetIPString(Value: string);
begin
  FIPAddress := IPStringToDword(Value);
  SendMessage(Handle, IPM_SETADDRESS, 0, FIPAddress);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TIPEdit]);
end;

end.

Скачать весь проект