在Delphi中去哪儿找IP地址的输入控件?(100分)

  • 主题发起人 主题发起人 mldhxyz
  • 开始时间 开始时间
用google.com搜一下!!!一大堆!!!
 
{*******************************************************}
{ }
{ IpEdit v1.01 }
{ }
{ Copyright (c) 2002-1 Liren Zhao BeiJing China }
{ }
{ HomePage: Http://Stef.533.net/54 }
{ Http://Aojianjianghu.126.com }
{ Address:Beijing Syntong Tech Delvelop co.,LTD }
{ Email:Liren.z@163.com }
{ }
{*******************************************************}
unit IpEdit;

interface

uses Windows, Messages, SysUtils, Classes,
Forms, Controls, ComCtrls, CommCtrl, DsgnIntf, StdCtrls, Mask;

type
TFieldRange = record
LowRange: Byte;
HighRange: Byte;
end;

TFieldChangeEvent = procedure(Sender: TObject; OldField, Value: Byte) of Object;

TIPEdit = class(TWinControl)
private
// 新增,IP 地址(字串)
FIPAddress: string;

FIP: LongWord;
FFields:array[0..3] of Byte;
FFieldRanges: array [0..3] of TFieldRange;
FCreating: Boolean;
FOnChange: TNotifyEvent;
FOnEnter: TNotifyEvent;
FOnExit: TNotifyEvent;
FOnFieldChange: TFieldChangeEvent;
procedure SetIP(Value: LongWord);
function GetIP: LongWord;
function GetField(Index:Integer):Byte;
procedure SetField(Index:Integer; B:Byte);
function GetFieldRange(Field: Integer): TFieldRange;
procedure SetFieldRange(Field:integer; Value: TFieldRange);
procedure SetIPAddress;
function GetBlank: Boolean;
procedure WMNotifyFormat(var Message: TMessage); message WM_NOTIFYFORMAT;
//处理IP控件的通知消息IPN_FIELDCHANGED
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;

// 新增,IP 地址的设置和获得
procedure SetIPString(Value: string);
function GetIPString: string;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
//清除IP控件中的IP串
procedure Clear;
//设置IP控件的输入焦点(field的有效取值为0..3)
procedure SetFieldFocus(Field:Byte);
published
// 新增,IP 地址(发布)
property IPAddress: string read GetIpString write SetIPString;

//判断IP控件的IP串是否为空
property Blank: Boolean read GetBlank;
//Field0到Field3分别为IP控件的4个部分的值
property Field0: Byte index 0 read GetField write SetField;
property Field1: Byte index 1 read GetField write SetField;
property Field2: Byte index 2 read GetField write SetField;
property Field3: Byte index 3 read GetField write SetField;
//Field0Range到Field3Range限制IP控件各部分的取值的范围
property Field0Range: TFieldRange index 0 read GetFieldRange write SetFieldRange;
property Field1Range: TFieldRange index 1 read GetFieldRange write SetFieldRange;
property Field2Range: TFieldRange index 2 read GetFieldRange write SetFieldRange;
property Field3Range: TFieldRange index 3 read GetFieldRange write SetFieldRange;
//IP地址值(32位整数LongWord)
property IP: LongWord read GetIP write SetIP;
//The About box
// property About:TAboutProperty read fAbout;

//事件属性
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
property OnExit: TNotifyEvent read FOnExit write FOnExit;
property OnFieldChange: TFieldChangeEvent read FOnFieldChange write FOnFieldChange;

//以下属性继承自TWinControl控件
property Enabled;
property TabOrder;
property TabStop;
property ParentShowHint;
property ShowHint;
property Hint;
property Visible;

// Add by Guoshj
property Anchors;
property Font;
property ParentFont;
end;

procedure Register;

implementation

{~~~~~~~~~~~~~~~~~~~~~~TIPEdit~~~~~~~~~~~~~~~~~~~~~~~~}
constructor TIPEdit.Create(AOwner: TComponent);
var
i: integer;
begin
//初始化ICC_INTERNET_CLASSES类控件
CheckCommonControl(ICC_INTERNET_CLASSES);
inherited Create(AOwner);
for i:= 0 to 3 do
begin
FFieldRanges.LowRange:= 0;
FFieldRanges.HighRange:= 255;
FFields:=0;
end;
FIP:=0;
FIPAddress := '0.0.0.0';
Height:= 25;
Width:= 152;
TabSTop:= True;
end;

procedure TIPEdit.DestroyWnd;
begin
inherited DestroyWnd
end;

destructor TIPEdit.Destroy;
begin
inherited Destroy;
end;

procedure TIPEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
CreateSubClass(Params, WC_IPADDRESS);
with Params do
begin
end;
end;

procedure TIPEdit.CreateWnd;
begin
FCreating := True;
try
inherited CreateWnd;
SetIPAddress;
finally
FCreating := False;
end;
end;

function TIPEdit.GetBlank: Boolean;
begin
Result:= Boolean(SendMessage(Handle, IPM_ISBLANK, 0, 0));
end;

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

procedure TIPEdit.SetFieldFocus(Field:Byte);
begin
SendMessage(Handle, IPM_SETFOCUS, Field, 0);
end;

function TIPEdit.GetFieldRange(Field: Integer): TFieldRange;
begin
Result:= FFieldRanges[Field];
end;

procedure TIPEdit.SetFieldRange(Field: Integer; Value: TFieldRange);
begin
if Value.LowRange > Value.HighRange then exit;
if (FFieldRanges[Field].LowRange <> Value.LowRange) or
(FFieldRanges[Field].HighRange <> Value.HighRange) then
begin
FFieldRanges[Field]:= Value;
SendMessage(Handle, IPM_SETRANGE, Field,
MakeIPRange(Value.LowRange, Value.HighRange));
end;
end;

function TIPEdit.GetField(Index: Integer): Byte;
begin
if (Index>=0)and(Index<=3) then Result:=FFields[Index]
else Result:=0;
end;

procedure TIPEdit.SetField(Index:Integer; B:Byte);
begin
if (FFields[Index] <> B)then
begin
FFields[Index]:=B;
SetIPAddress;
end;
end;

procedure TIPEdit.SetIPAddress;
var
i:LongWord;
begin
i:=MAKEIPADDRESS(FFields[0], FFields[1], FFields[2], FFields[3]);
SendMessage(Handle, IPM_SETADDRESS, 0, i);
FIP:=i;
end;

procedure TIPEdit.SetIP(Value: LongWord);
begin
if (FIP <> Value) then
begin
FFields[0]:= First_IPAddress(Value);
FFields[1]:= Second_IPAddress(Value);
FFields[2]:= Third_IPAddress(Value);
FFields[3]:= Fourth_IPAddress(Value);
SetIPAddress;
end;
end;

function TIPEdit.GetIP: LongWord;
begin
SendMessage(Handle, IPM_GETADDRESS, 0, Integer(@Result));
end;

procedure TIPEdit.WMNotifyFormat(var Message: TMessage);
begin
with Message do
Result := DefWindowProc(Handle, Msg, WParam, LParam);
end;

procedure TIPEdit.CNNotify(var Message: TWMNotify);
var
pNM: PNMIPAddress;
begin
with (Message.NMHdr)^ do
begin
case Code of
IPN_FIELDCHANGED:
begin
pNM:= PNMIPADDRESS(Message.NMHdr);
if (pNM^.iField>=0)and(pNM^.iField<=3) then
FFields[pNM^.iField]:=pNM^.iValue;
if Assigned(FOnFieldChange) then
FOnFieldChange(self, pNM^.iField, pNM^.iValue);
end;
end;
end;
end;

procedure TIPEdit.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
EN_CHANGE:
begin
if not FCreating then
if Assigned(FOnChange) then FOnChange(self);
end;
EN_KILLFOCUS: if Assigned(FOnExit) then FOnExit(self);
EN_SETFOCUS: if Assigned(FOnEnter) then FOnEnter(self);
end;
end;

// 新增,设置新的 IP 地址
procedure TIpEdit.SetIPString(Value: string);
// 转化'a.a.a.a'的字段为32为整数
function IP2Int(Value: string): Integer;
var
I: Integer;
strs: TStrings;
begin
strs := TStringList.Create;
Value := StringReplace(Value, '.', ',', [rfReplaceAll]);
strs.CommaText := Value;
Result := 0;
try
for I := 0 to strs.Count - 1 do // Iterate
begin // 2130706433
Result := Result shl 8 + StrToInt(strs);
end; // for
except
Result := -1;
Application.MessageBox('地址格式错误', nil, MB_OK + MB_ICONERROR);
end;

strs.Free;
end;
var
i: Integer;
begin
if FIPAddress <> Value then
begin
i := IP2Int(Value);
if i <> -1 then
begin
FIPAddress := Value;
FFields[0]:= First_IPAddress(i);
FFields[1]:= Second_IPAddress(i);
FFields[2]:= Third_IPAddress(i);
FFields[3]:= Fourth_IPAddress(i);
SetIPAddress;
end;
end;
end;

// 新增,获取新的 IP 地址
function TIpEdit.GetIPString: string;
begin
FIPAddress := Format('%d.%d.%d.%d', [FFields[0], FFields[1], FFields[2], FFields[3]]);
Result := FIpAddress;
end;

procedure Register;
begin
RegisterComponents('Liren.z', [TIPEdit]);
end;

end.

 
不用如此麻烦, 几句代码就搞定了:

uses
ComCtrls, CommCtrl;

TIpEdit = class(TEdit)
procedure CreateParams(var Params: TCreateParams); override;
end;

{ TIpEdit }

procedure TIpEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
InitCommonControl(ICC_INTERNET_CLASSES);
CreateSubClass(Params, WC_IPADDRESS);
end;

够简单, 该有的都有了。[:)]
 
按照楼上的方法

unit IPAddressEdit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ComCtrls, CommCtrl,
StdCtrls;

type
TIPAddressEdit = class(TEdit)
private
{ Private declarations }
protected
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public declarations }
published
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Liren.z', [TIPAddressEdit]);
end;

{ TIPAddressEdit }

procedure TIPAddressEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
InitCommonControl(ICC_INTERNET_CLASSES);
CreateSubClass(Params, WC_IPADDRESS);
end;

end.
 
后退
顶部