写了个组件 让大家给点意见(里面有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.
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.
相关文章推荐
- 准备开源两个delphi组件,想听听大家的意见
- 资金计划报表sql 希望大家给点意见,指出我的存储过程里面的错误的地方
- 教大家利用bug漏洞免费申请QQ靓号
- 邮件主机的一些问题。希望大家提供好的意见
- <C/C++函数与算法速查手册>(中国铁道)勘误意见,欢迎大家对本书的错误多指正。
- <C/C++函数与算法速查手册>(中国铁道)勘误意见,欢迎大家对本书的错误多指正。
- win7下安装IIS,找不到里面的组件或选项
- 征求大家意见,11月的活动安排在上午还是下午好?
- vue里面父组件如何修改子组件样式
- 用友盟意见反馈组件鲸鱼体UI风格居然被 Apple拒绝上架
- 一批不错的BUG跟踪系统,值得大家采纳使用
- 2006年开始了,首先祝大家在新的一年里面一切顺利,身体健康,发大财。
- 关于yii2里面的\yii\helpers\Url组件
- .NET定时任务执行管理器开源组件–FluentScheduler,可以在web应用程序里面使用
- http协议 使用httpserver组件完成server(服务端)接受post请求数据并使用3DES+base64加解密希望对大家有帮助
- Asp.net_解决vs运行报在安装 32 位 Oracle 客户端组件的情况下以 64 位模式运行,将出现此问题的bug方法
- 一个简单的通讯服务框架(大家发表意见一起研究)JAVA版本
- 大家一起看看,给点意见
- 解决 vue component(组件)里面每个.vue文件的style互相影响的问题
- 零基础学数据结构马上改版完毕,欢迎大家多提宝贵意见。