哪位高人写过IP地址控件或有IP地址控件的源码吗？？

[xiaofeng_cxy]

在下感激不尽！！
在线等候！！

[xiaofeng_cxy]

只是想学习一下写IP地址控件！！！
请指教！！！

[Billy_Chen28]

这里有一个：
http://vcl.vclxx.org/DELPHI/D32FREE/PHIPADD.ZIP

试试以下代码：
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.

[Billy_Chen28]

D6中已经有了一个TIPAddress//IP地址组件

[xiaofeng_cxy]

这样只是调用windows本身的ip地址控件吧？？
我想要一个具体实现的！！！
只是出于学习的目的

[Billy_Chen28]

这是一个完整的源代码：
unit CXIPAddress;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
,commctrl,comctrls;

type
TFieldRange = record
LowRange: Byte;
HighRange: Byte;
end;
TphFieldChange = procedure(Sender: TObject; Field: Integer;
Value: Integer) of object;
TCXIPAddress = class(TWinControl)
private
{ Private declarations }
FActiveField:Byte;
FCreating: Boolean;
FValue: LongInt;
FFieldRanges: array [0..3] of TFieldRange;
FOnChange: TNotifyEvent;
FOnEnter: TNotifyEvent;
FOnExit: TNotifyEvent;
FOnFieldChange: TphFieldChange;
FFirstIPAddress: Byte;
FSecondIPAddress: Byte;
FThirdIPAddress: Byte;
FFourthIPAddress: Byte;
procedure SetActiveField(Value:Byte);
function GetFirstIPAddress: Byte;
procedure SetFirstIPAddress(Value: Byte);
function GetSecondIPAddress: Byte;
procedure SetSecondIPAddress(Value: Byte);
function GetThirdIPAddress: Byte;
procedure SetThirdIPAddress(Value: Byte);
function GetFourthIPAddress: Byte;
procedure SetFourthIPAddress(Value: Byte);
function GetIPAddress: LongInt;
procedure SetIPAddress(Value:Longint);
function GetBlank: Boolean;
function GetFieldRanges(Field: Integer): TFieldRange;
procedure SetFieldRanges(Field:integer; Value: TFieldRange);
//procedure SetValue(Value: Cardinal);
//function GetValue: LongInt;
//procedure WMNotifyFormat(var Message: TMessage); message WM_NOTIFYFORMAT;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
//procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure ClearAddress;
function StringToIp(Value: String): Longint;
function IPToString(Ip: Longint): string;
procedure SetAllRanges(Range: TFieldRange);
property IPAddress: Longint read GetIPAddress write SetIPAddress;
published
property ActiveField: Byte read FActiveField write SetActiveField;
property Blank: Boolean read GetBlank;
property FirstRange: TFieldRange index 0 read GetFieldRanges write SetFieldRanges;
property SecondRange: TFieldRange index 1 read GetFieldRanges write SetFieldRanges;
property ThirdRange: TFieldRange index 2 read GetFieldRanges write SetFieldRanges;
property FourthRange: TFieldRange index 3 read GetFieldRanges write SetFieldRanges;
property Field0: Byte read GetFirstIPAddress write SetFirstIPAddress;
property Field1: Byte read GetSecondIPAddress write SetSecondIPAddress;
property Field2: Byte read GetThirdIPAddress write SetThirdIPAddress;
property Field3: Byte read GetFourthIPAddress write SetFourthIPAddress;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
property OnExit: TNotifyEvent read FOnExit write FOnExit;
property OnFieldChange: TphFieldChange read FOnFieldChange write FOnFieldChange;
property Font;
property Enabled;
property TabOrder;
property TabStop;
property ParentShowHint;
property ShowHint;
property Hint;
property PopupMenu;
property Visible;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('CXLib', [TCXIPAddress]);
end;
procedure TCXIPAddress.ClearAddress;
begin
Perform(IPM_CLEARADDRESS, 0, 0);
end;
procedure TCXIPAddress.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
EN_CHANGE:
if not FCreating then
if Assigned(FOnChange) then FOnChange(self);
EN_KILLFOCUS:
if Assigned(FOnExit) then FOnExit(self);
EN_SETFOCUS:
if Assigned(FOnEnter) then FOnEnter(self);
end;
end;
procedure TCXIPAddress.CNNotify(var Message: TWMNotify);
var
IPAddress: PNMIPADDRESS;
begin
with (Message.NMHdr)^ do
begin
case Code of
IPN_FIELDCHANGED:
begin
IPAddress:= PNMIPADDRESS(Message.NMHdr);
FActiveField:=IPAddress^.iField;
case IPAddress^.iField of
0: FFirstIPAddress := IPAddress^.iValue;
1: FSecondIPAddress := IPAddress^.iValue;
2: FThirdIPAddress := IPAddress^.iValue;
3: FFourthIPAddress := IPAddress^.iValue;
end;
if Assigned(FOnFieldChange) then FOnFieldChange(self,
IPAddress^.iField, IPAddress^.iValue);
end;
end;
end;
end;

[Billy_Chen28]

constructor TCXIPAddress.Create(AOwner: TComponent);
var
i: integer;
begin
CheckCommonControl(ICC_INTERNET_CLASSES or ICC_BAR_CLASSES);
inherited Create(AOwner);
For i:= 0 to 3 do
begin
FFieldRanges[i].LowRange:= 0;
FFieldRanges[i].HighRange:= 255;
end;
FFirstIPAddress:= 0;
FSecondIPAddress:= 0;
FThirdIPAddress:= 0;
FFourthIPAddress:= 0;
FValue:= MakeIPAddress(FFirstIPAddress, FSecondIPAddress,
FThirdIPAddress, FFourthIPAddress);
Height:= 25;
Width:= 151;
TabSTop:= True;
end;
procedure TCXIPAddress.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
CreateSubClass(Params, WC_IPADDRESS);
end;
procedure TCXIPAddress.CreateWnd;
begin
FCreating := True;
try
inherited CreateWnd;
SetIPAddress(FValue);
finally
FCreating := False;
end;
end;
function TCXIPAddress.GetBlank: Boolean;
begin
Result:= Boolean(perform(IPM_ISBLANK, 0, 0));
end;
function TCXIPAddress.GetFieldRanges(Field: Integer): TFieldRange;
begin
Result:= FFieldRanges[Field];
end;
function TCXIPAddress.GetFirstIPAddress: Byte;
begin
Result:= FIRST_IPADDRESS(IPAddress);//GetIPAddress(0);
end;
function TCXIPAddress.GetFourthIPAddress: Byte;
begin
Result:= FOURTH_IPADDRESS(IPAddress);//GetIPAddress(3);
end;
function TCXIPAddress.GetIPAddress: LongInt;
var
buffer: LongInt;
begin
buffer:= 0;
perform(IPM_GETADDRESS, 0, LongInt(@Buffer));
Result:= Buffer;
end;
function TCXIPAddress.GetSecondIPAddress: Byte;
begin
Result:= SECOND_IPADDRESS(IPAddress);//GetIPAddress(1);
end;
function TCXIPAddress.GetThirdIPAddress: Byte;
begin
Result:=THIRD_IPADDRESS(IPAddress); //GetIPAddress(2);
end;
procedure TCXIPAddress.SetActiveField(Value: Byte);
begin
if FActiveField=Value then Exit;
if ( Value < 4 ) then begin
SendMessage(Handle, IPM_SETFOCUS, wParam(Value), 0);
FActiveField:= Value;
end;
end;
procedure TCXIPAddress.SetAllRanges(Range: TFieldRange);
var
I:integer;
begin
for i:= 0 to 3 do
begin
SetFieldRanges(i, Range);
end;
end;
procedure TCXIPAddress.SetFieldRanges(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;
perform(IPM_SETRANGE, Field,
MakeIPRange(Value.LowRange, Value.HighRange));
end;
end;
procedure TCXIPAddress.SetFirstIPAddress(Value: Byte);
begin
if (FFirstIPAddress <> Value) then
begin
FFirstIPAddress:= Value;
IPAddress:=MAKEIPADDRESS(FFirstIPAddress, FSecondIPAddress,
FThirdIPAddress, FFourthIPAddress);
end;
end;
procedure TCXIPAddress.SetFourthIPAddress(Value: Byte);
begin
if (FFourthIPAddress <> Value) then
begin
FFourthIPAddress:= Value;
IPAddress:=MAKEIPADDRESS(FFirstIPAddress, FSecondIPAddress,
FThirdIPAddress, FFourthIPAddress);//SetIPAddress;
end;
end;
procedure TCXIPAddress.SetIPAddress(Value:Longint);
begin
if FValue=Value then Exit;
Perform(IPM_SETADDRESS, 0,
MAKEIPADDRESS(FFirstIPAddress, FSecondIPAddress,
FThirdIPAddress, FFourthIPAddress));
Perform(IPM_GETADDRESS, 0, Longint(@FValue));
end;
procedure TCXIPAddress.SetSecondIPAddress(Value: Byte);
begin
if (FSecondIPAddress <> Value) then
begin
FSecondIPAddress:= Value;
IPAddress:=MAKEIPADDRESS(FFirstIPAddress, FSecondIPAddress,
FThirdIPAddress, FFourthIPAddress);//SetIPAddress;
end;
end;
procedure TCXIPAddress.SetThirdIPAddress(Value: Byte);
begin
if (FThirdIPAddress <> Value) then
begin
FThirdIPAddress:= Value;
IPAddress:=MAKEIPADDRESS(FFirstIPAddress, FSecondIPAddress,
FThirdIPAddress, FFourthIPAddress);//SetIPAddress(;
end;
end;
function TCXIPAddress.IPToString(Ip: Longint):string;
begin
Result:= IntToStr(First_IPAddress(Ip))+'.'+IntToStr(Second_IPAddress(Ip))+'.'+
IntToStr(Third_IPAddress(Ip))+'.'+IntToStr(Fourth_IPAddress(Ip));
end;
function TCXIPAddress.StringToIp(Value: string):LongInt;
var B: Array[0..3] of Byte;
Str: String;
i, Cnt : Integer;
begin
B[0]:= 0;
B[1]:= 0;
B[2]:= 0;
B[3]:= 0;
Cnt:= 0;
i:= Pos('.', Value);
while (Length(Value) > 0) and ( Cnt < 4 ) do begin
if ( i = 0 ) then i:= Length(Value)+1;
Str:= Copy(Value, 0, i-1);
B[Cnt]:= StrToInt(Str);
Value:= Copy(Value, i+1, Length(Value));
i:= Pos('.', Value);
Inc(Cnt);
end;
Result:= MakeIPAddress(b[0], b[1], b[2], b[3]);
end;
end.
//改进ipaddress变成ip,增加字符串形式的ipAddress

[xiaofeng_cxy]

我说了我是想学习一下如何来写的！！
只是想看看源码,并不是使用！！！！
请高人指点了！！！

[Billy_Chen28]

以上是一个IP地址控件源码

[xiaofeng_cxy]

从TCustomEdit继承不行吗？？？
完全自己写处理的过程！！！

[xiaofeng_cxy]

没有人吗？？？

[breezing]

http://expert.csdn.net/Expert/topic/1191/1191046.xml?temp=.2194178

[ly_liuyang]

网上有很多,这就有
http://delphi.icm.edu.pl/ftp/d40free/ipaddrctl.zip