您的位置:首页 > 其它

写了个组件 让大家给点意见(里面有N多BUG)

2006-07-19 13:00 531 查看
{
Liisyong 200607019
IP地址组件
版本2.0

}
unit IpAdress;

interface

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

type

////********************************************************/
TCustomIPAdress = class; //类TCustomIPAdress预定义

TIPAdressFieldChangeEvent = procedure (Sender: TCustomIpadress; OldField, Value: Byte) of object;
{TIPAdressFieldChangeEvent =
procedure (Sender: TCustomIpadress;
OldField, Value: Byte) of object; ???? 查资料}
//声明事件
TIPAdressChangeEvent = procedure (Sender: TCustomIpadress; IPAdress: String) of object;

TCustomIPAdress = class(TWinControl) /// 组件的祖先类名TWinControl

////********************************************************/

private
//私有属性声明
{ Private declarations }

FOnIPChange: TIPAdressChangeEvent;
FOnIPFieldChange: TIPAdressFieldChangeEvent;

FMinIPAdress: Longint; //对IP地址大小进行限制 的事件 ??
FMaxIPAdress: Longint;

FActiveField: Byte;
FAutoSize: Boolean;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;

protected
//保护类型
{ Protected declarations }

procedure CreateParams(var Params: TCreateParams); override;

function GetMinIPAdress: String; //限制函数声明
function GetMaxIPAdress: String;
function GetIPAdress: String;

procedure SetMinIPAdress(Value: String); { 字段数字设置}
procedure SetMaxIPAdress(Value: String);
procedure SetIPAdress(Value: String);

function GetEmpty: Boolean;
procedure SetActiveField(Value: Byte);

public //属性的声明处
{ Public declarations }
// TIPAdress = class(TCustomIPAdress)
//TIPAdress class(TCustomIPAdress) ;

constructor Create(AOwner: TComponent); override;
function IPToString(Ip: Longint): String;
function StringToIP(Value: String): Longint;
procedure Clear;
property ActiveField: Byte read FActiveField write SetActiveField;
property Empty: Boolean read GetEmpty;

property MinIPAdress: String read GetMinIPAdress write SetMinIPAdress;
property MaxIPAdress: String read GetMaxIPAdress write SetMaxIPAdress;
property IPAdress: String read GetIPAdress write SetIPAdress;
property OnIPChange: TIPAdressChangeEvent read FOnIPChange write FOnIPChange;
property OnIPFieldChange: TIPAdressFieldChangeEvent read FOnIPFieldChange write FOnIPFieldChange;

published //属性的声明处 没有完成??
// 编译出错 ???????????
{ Published declarations }
{ property ActiveField;
property Empty;
property MinIPAdress;
property MaxIPAdress;
property IPAdress;
property OnIPChange;
property OnIPFieldChange;
property Font;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Tag;
property DragCursor;
property DragMode;
property HelpContext; }

end;

procedure Register; ////组件的注册 为了避免破坏IDE和CUP ------->安全

implementation

procedure Register;
begin
// RegisterComponents('IP', [Ipadress]);
RegisterComponents('Standard', [TCustomIPAdress]);
////为什么Ipdress 不行啊 [Error] Ipadress.pas(108): '.' expected but ']' found ??
end;

//////////////////********************************************/

constructor TCustomIPAdress.Create(AOwner: TComponent);
begin /////
inherited Create(AOwner);
if NewStyleControls then
ControlStyle := [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight]
else
ControlStyle := [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight, csFramed];

ParentColor := False; //属性参数初始化
FAutoSize := True;
Width:= 100;
Height:= 25;
TabStop:= True;
FMinIPAdress:= 0;
FMaxIPAdress:= $0FFFFFFFF;
FActiveField:= 0;
FOnIPChange:= nil;
FOnIPFieldChange:= nil;
end;

//////////////////*************CreateParams*******************************/
procedure TCustomIPAdress.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;

//////////////////*************CNNotify*******************************/
procedure TCustomIPAdress.CNNotify(var Message: TWMNotify);
begin
with Message.NMHdr^ do begin
case Code of
IPN_FIELDCHANGED :
begin
FActiveField:= PNMIPAddress(Message.NMHdr)^.iField;
if Assigned(OnIpFieldChange) then
with PNMIPAddress(Message.NMHdr)^ do begin
OnIPFieldChange(Self, iField, iValue);
end;
end;
end;
end;
end;

{

ipEdit:=CreateWindow(WC_IPADDRESS,nil,WS_CHILD or WS_VISIBLE,91,88,130,23,self.Handle,0,
hInstance,nil);
看一下Windows 的API,这里建立了一个系统注册的类。
WC_IPADDRESS就是Ip地址输入框,还可以是其他类型:
WC_LISTVIEW = 'SysListView32';
WC_TREEVIEW = 'SysTreeView32';
WC_COMBOBOXEX = 'ComboBoxEx32';
WC_TABCONTROL = 'SysTabControl32';
WC_IPADDRESS = 'SysIPAddress32';
}

//////////////////***********************获取IP地址*********************/
function TCustomIPAdress.GetIPAdress: String;
var Ip: Longint;
begin
SendMessage(Handle, IPM_GETADDRESS, 0, Longint(@Ip));
Result:= IPToString(Ip);
end;

function TCustomIpadress.GetMinIPAdress: String;
begin
Result:= IPToString(FMinIPAdress);
end;

//////////////////***************SetMinIPAdress*****************************/
procedure TCustomIPAdress.SetMinIPAdress(Value: String);
begin
FMinIPAdress:= StringToIp(Value);
SendMessage(Handle, IPM_SETRANGE, 0, MakeIpRange(First_IPAddress(FMinIPAdress), First_IPAddress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 1, MakeIpRange(Second_IPAddress(FMinIPAdress), Second_IPAddress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 2, MakeIpRange(Third_IPAddress(FMinIPAdress), Third_IPAddress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 3, MakeIpRange(Fourth_IPAddress(FMinIPAdress), Fourth_IPAddress(FMaxIPAdress)));
end;

//////////////////**************GetMaxIPAdress******************************/
function TCustomIPAdress.GetMaxIPAdress: String;
begin
Result:= IPToString(FMaxIPAdress);
end;

//////////////////**************SetMaxIPAdress******************************/

{ from SDK:
LRESULT SendMessage(

HWND hWnd, // handle of destination window
UINT Msg, // message to send
WPARAM wParam, // first message parameter
LPARAM lParam // second message parameter
);
}

procedure TCustomIpadress.SetMaxIPAdress(Value: String);
begin
FMaxIPAdress:= StringToIp(Value);
SendMessage(Handle, IPM_SETRANGE, 0, MakeIpRange(First_IPAddress(FMinIPAdress), First_IPAddress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 1, MakeIpRange(Second_IPAddress(FMinIPAdress), Second_IPAddress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 2, MakeIpRange(Third_IPAddress(FMinIPAdress), Third_IPAddress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 3, MakeIpRange(Fourth_IPAddress(FMinIPAdress), Fourth_IPAddress(FMaxIPAdress)));
end;

//////////////////**************SetIPAdress******************************/
procedure TCustomIPAdress.SetIPAdress(Value: String);
begin
SendMessage(Handle, IPM_SETADDRESS, 0, StringToIp(Value));
end;

//////////////////***********清空*********************************/
function TCustomIPAdress.GetEmpty: Boolean;
begin
Result:= Boolean(SendMessage(Handle, IPM_ISBLANK, 0, 0));
end;

//////////////////********************************************/
procedure TCustomIPAdress.Clear;
begin
SendMessage(Handle, IPM_CLEARADDRESS, 0, 0);
end;

//////////////////***************SetActiveField*****************************/

procedure TCustomIPAdress.SetActiveField(Value: Byte);
begin
if ( Value < 4 ) then begin
SendMessage(Handle, IPM_SETFOCUS, wParam(Value), 0);
FActiveField:= Value;
end;
end;

//////////////////*************StringToIp*******************************/
function TCustomIPAdress.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]);
///是定义在CommCtrl中的函数 格式 function MAKEIPADDRESS(b1, b2, b3, b4: DWORD): LPARAM;

{
Delphi中,是定义在CommCtrl

function MAKEIPADDRESS(b1, b2, b3, b4: DWORD): LPARAM;
begin
Result := (b1 shl 24) + (b2 shl 16) + (b3 shl 8) + b4;
end;

function FIRST_IPADDRESS(x: DWORD): DWORD;
begin
Result := (x shr 24) and $FF;
end;

function SECOND_IPADDRESS(x: DWORD): DWORD;
begin
Result := (x shr 16) and $FF;
end;

function THIRD_IPADDRESS(x: DWORD): DWORD;
begin
Result := (x shr 8) and $FF;
end;

function FOURTH_IPADDRESS(x: DWORD): DWORD;
begin
Result := x and $FF;
end;

这些是delphi中系统自带的

}
end;

//////////////////***********IPToString*********************************/

function TCustomIPAdress.IPToString(Ip: Longint): String;
begin
Result:= IntToStr(First_IPAddress(Ip))+'.'+IntToStr(Second_IPAddress(Ip))+'.'+
IntToStr(Third_IPAddress(Ip))+'.'+IntToStr(Fourth_IPAddress(Ip));
end;

//////////////////**********CNCommand**********************************/
procedure TCustomIPAdress.CNCommand(var Message: TWMCommand);
begin
if (Message.NotifyCode = EN_CHANGE) and Assigned(OnIpChange) then
OnIPChange(Self, IPAdress);
end;

end.
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐